home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl-5.003.tar.gz / perl-5.003.tar / perl-5.003 / pp.c < prev    next >
C/C++ Source or Header  |  1996-02-23  |  65KB  |  3,513 lines
  1. /*    pp.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12.  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. static void doencodes _((SV *sv, char *s, I32 len));
  19.  
  20. /* variations on pp_null */
  21.  
  22. PP(pp_stub)
  23. {
  24.     dSP;
  25.     if (GIMME != G_ARRAY) {
  26.     XPUSHs(&sv_undef);
  27.     }
  28.     RETURN;
  29. }
  30.  
  31. PP(pp_scalar)
  32. {
  33.     return NORMAL;
  34. }
  35.  
  36. /* Pushy stuff. */
  37.  
  38. PP(pp_padav)
  39. {
  40.     dSP; dTARGET;
  41.     if (op->op_private & OPpLVAL_INTRO)
  42.     SAVECLEARSV(curpad[op->op_targ]);
  43.     EXTEND(SP, 1);
  44.     if (op->op_flags & OPf_REF) {
  45.     PUSHs(TARG);
  46.     RETURN;
  47.     }
  48.     if (GIMME == G_ARRAY) {
  49.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  50.     EXTEND(SP, maxarg);
  51.     Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  52.     SP += maxarg;
  53.     }
  54.     else {
  55.     SV* sv = sv_newmortal();
  56.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  57.     sv_setiv(sv, maxarg);
  58.     PUSHs(sv);
  59.     }
  60.     RETURN;
  61. }
  62.  
  63. PP(pp_padhv)
  64. {
  65.     dSP; dTARGET;
  66.     XPUSHs(TARG);
  67.     if (op->op_private & OPpLVAL_INTRO)
  68.     SAVECLEARSV(curpad[op->op_targ]);
  69.     if (op->op_flags & OPf_REF)
  70.     RETURN;
  71.     if (GIMME == G_ARRAY) { /* array wanted */
  72.     RETURNOP(do_kv(ARGS));
  73.     }
  74.     else {
  75.     SV* sv = sv_newmortal();
  76.     if (HvFILL((HV*)TARG)) {
  77.         sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
  78.         sv_setpv(sv, buf);
  79.     }
  80.     else
  81.         sv_setiv(sv, 0);
  82.     SETs(sv);
  83.     RETURN;
  84.     }
  85. }
  86.  
  87. PP(pp_padany)
  88. {
  89.     DIE("NOT IMPL LINE %d",__LINE__);
  90. }
  91.  
  92. /* Translations. */
  93.  
  94. PP(pp_rv2gv)
  95. {
  96.     dSP; dTOPss;
  97.     
  98.     if (SvROK(sv)) {
  99.       wasref:
  100.     sv = SvRV(sv);
  101.     if (SvTYPE(sv) != SVt_PVGV)
  102.         DIE("Not a GLOB reference");
  103.     }
  104.     else {
  105.     if (SvTYPE(sv) != SVt_PVGV) {
  106.         char *sym;
  107.  
  108.         if (SvGMAGICAL(sv)) {
  109.         mg_get(sv);
  110.         if (SvROK(sv))
  111.             goto wasref;
  112.         }
  113.         if (!SvOK(sv)) {
  114.         if (op->op_flags & OPf_REF ||
  115.             op->op_private & HINT_STRICT_REFS)
  116.             DIE(no_usym, "a symbol");
  117.         RETSETUNDEF;
  118.         }
  119.         sym = SvPV(sv, na);
  120.         if (op->op_private & HINT_STRICT_REFS)
  121.         DIE(no_symref, sym, "a symbol");
  122.         sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
  123.     }
  124.     }
  125.     if (op->op_private & OPpLVAL_INTRO) {
  126.     GP *ogp = GvGP(sv);
  127.  
  128.     SSCHECK(3);
  129.     SSPUSHPTR(SvREFCNT_inc(sv));
  130.     SSPUSHPTR(ogp);
  131.     SSPUSHINT(SAVEt_GP);
  132.  
  133.     if (op->op_flags & OPf_SPECIAL) {
  134.         GvGP(sv)->gp_refcnt++;        /* will soon be assigned */
  135.         GvINTRO_on(sv);
  136.     }
  137.     else {
  138.         GP *gp;
  139.         Newz(602,gp, 1, GP);
  140.         GvGP(sv) = gp;
  141.         GvREFCNT(sv) = 1;
  142.         GvSV(sv) = NEWSV(72,0);
  143.         GvLINE(sv) = curcop->cop_line;
  144.         GvEGV(sv) = sv;
  145.     }
  146.     }
  147.     SETs(sv);
  148.     RETURN;
  149. }
  150.  
  151. PP(pp_rv2sv)
  152. {
  153.     dSP; dTOPss;
  154.  
  155.     if (SvROK(sv)) {
  156.       wasref:
  157.     sv = SvRV(sv);
  158.     switch (SvTYPE(sv)) {
  159.     case SVt_PVAV:
  160.     case SVt_PVHV:
  161.     case SVt_PVCV:
  162.         DIE("Not a SCALAR reference");
  163.     }
  164.     }
  165.     else {
  166.     GV *gv = sv;
  167.     char *sym;
  168.  
  169.     if (SvTYPE(gv) != SVt_PVGV) {
  170.         if (SvGMAGICAL(sv)) {
  171.         mg_get(sv);
  172.         if (SvROK(sv))
  173.             goto wasref;
  174.         }
  175.         if (!SvOK(sv)) {
  176.         if (op->op_flags & OPf_REF ||
  177.             op->op_private & HINT_STRICT_REFS)
  178.             DIE(no_usym, "a SCALAR");
  179.         RETSETUNDEF;
  180.         }
  181.         sym = SvPV(sv, na);
  182.         if (op->op_private & HINT_STRICT_REFS)
  183.         DIE(no_symref, sym, "a SCALAR");
  184.         gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
  185.     }
  186.     sv = GvSV(gv);
  187.     }
  188.     if (op->op_flags & OPf_MOD) {
  189.     if (op->op_private & OPpLVAL_INTRO)
  190.         sv = save_scalar((GV*)TOPs);
  191.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
  192.         provide_ref(op, sv);
  193.     }
  194.     SETs(sv);
  195.     RETURN;
  196. }
  197.  
  198. PP(pp_av2arylen)
  199. {
  200.     dSP;
  201.     AV *av = (AV*)TOPs;
  202.     SV *sv = AvARYLEN(av);
  203.     if (!sv) {
  204.     AvARYLEN(av) = sv = NEWSV(0,0);
  205.     sv_upgrade(sv, SVt_IV);
  206.     sv_magic(sv, (SV*)av, '#', Nullch, 0);
  207.     }
  208.     SETs(sv);
  209.     RETURN;
  210. }
  211.  
  212. PP(pp_pos)
  213. {
  214.     dSP; dTARGET; dPOPss;
  215.     
  216.     if (op->op_flags & OPf_MOD) {
  217.     LvTYPE(TARG) = '<';
  218.     LvTARG(TARG) = sv;
  219.     PUSHs(TARG);    /* no SvSETMAGIC */
  220.     RETURN;
  221.     }
  222.     else {
  223.     MAGIC* mg; 
  224.  
  225.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
  226.         mg = mg_find(sv, 'g');
  227.         if (mg && mg->mg_len >= 0) {
  228.         PUSHi(mg->mg_len + curcop->cop_arybase);
  229.         RETURN;
  230.         }
  231.     }
  232.     RETPUSHUNDEF;
  233.     }
  234. }
  235.  
  236. PP(pp_rv2cv)
  237. {
  238.     dSP;
  239.     GV *gv;
  240.     HV *stash;
  241.  
  242.     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
  243.     /* (But not in defined().) */
  244.     CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
  245.  
  246.     if (!cv)
  247.     cv = (CV*)&sv_undef;
  248.     SETs((SV*)cv);
  249.     RETURN;
  250. }
  251.  
  252. PP(pp_prototype)
  253. {
  254.     dSP;
  255.     CV *cv;
  256.     HV *stash;
  257.     GV *gv;
  258.     SV *ret;
  259.  
  260.     ret = &sv_undef;
  261.     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
  262.     if (cv && SvPOK(cv)) {
  263.     char *p = SvPVX(cv);
  264.     ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
  265.     }
  266.     SETs(ret);
  267.     RETURN;
  268. }
  269.  
  270. PP(pp_anoncode)
  271. {
  272.     dSP;
  273.     CV* cv = (CV*)cSVOP->op_sv;
  274.     EXTEND(SP,1);
  275.  
  276.     if (CvCLONE(cv))
  277.     cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
  278.  
  279.     PUSHs((SV*)cv);
  280.     RETURN;
  281. }
  282.  
  283. PP(pp_srefgen)
  284. {
  285.     dSP; dTOPss;
  286.     SV* rv;
  287.     rv = sv_newmortal();
  288.     sv_upgrade(rv, SVt_RV);
  289.     if (SvPADTMP(sv))
  290.     sv = newSVsv(sv);
  291.     else {
  292.     SvTEMP_off(sv);
  293.     (void)SvREFCNT_inc(sv);
  294.     }
  295.     SvRV(rv) = sv;
  296.     SvROK_on(rv);
  297.     SETs(rv);
  298.     RETURN;
  299. } 
  300.  
  301. PP(pp_refgen)
  302. {
  303.     dSP; dMARK;
  304.     SV* sv;
  305.     SV* rv;
  306.     if (GIMME != G_ARRAY) {
  307.     MARK[1] = *SP;
  308.     SP = MARK + 1;
  309.     }
  310.     while (MARK < SP) {
  311.     sv = *++MARK;
  312.     rv = sv_newmortal();
  313.     sv_upgrade(rv, SVt_RV);
  314.     if (SvPADTMP(sv))
  315.         sv = newSVsv(sv);
  316.     else {
  317.         SvTEMP_off(sv);
  318.         (void)SvREFCNT_inc(sv);
  319.     }
  320.     SvRV(rv) = sv;
  321.     SvROK_on(rv);
  322.     *MARK = rv;
  323.     }
  324.     RETURN;
  325. }
  326.  
  327. PP(pp_ref)
  328. {
  329.     dSP; dTARGET;
  330.     SV *sv;
  331.     char *pv;
  332.  
  333.     sv = POPs;
  334.     if (!sv || !SvROK(sv))
  335.     RETPUSHNO;
  336.  
  337.     sv = SvRV(sv);
  338.     pv = sv_reftype(sv,TRUE);
  339.     PUSHp(pv, strlen(pv));
  340.     RETURN;
  341. }
  342.  
  343. PP(pp_bless)
  344. {
  345.     dSP;
  346.     HV *stash;
  347.  
  348.     if (MAXARG == 1)
  349.     stash = curcop->cop_stash;
  350.     else
  351.     stash = gv_stashsv(POPs, TRUE);
  352.  
  353.     (void)sv_bless(TOPs, stash);
  354.     RETURN;
  355. }
  356.  
  357. /* Pattern matching */
  358.  
  359. PP(pp_study)
  360. {
  361.     dSP; dPOPss;
  362.     register unsigned char *s;
  363.     register I32 pos;
  364.     register I32 ch;
  365.     register I32 *sfirst;
  366.     register I32 *snext;
  367.     I32 retval;
  368.     STRLEN len;
  369.  
  370.     s = (unsigned char*)(SvPV(sv, len));
  371.     pos = len;
  372.     if (sv == lastscream)
  373.     SvSCREAM_off(sv);
  374.     else {
  375.     if (lastscream) {
  376.         SvSCREAM_off(lastscream);
  377.         SvREFCNT_dec(lastscream);
  378.     }
  379.     lastscream = SvREFCNT_inc(sv);
  380.     }
  381.     if (pos <= 0) {
  382.     retval = 0;
  383.     goto ret;
  384.     }
  385.     if (pos > maxscream) {
  386.     if (maxscream < 0) {
  387.         maxscream = pos + 80;
  388.         New(301, screamfirst, 256, I32);
  389.         New(302, screamnext, maxscream, I32);
  390.     }
  391.     else {
  392.         maxscream = pos + pos / 4;
  393.         Renew(screamnext, maxscream, I32);
  394.     }
  395.     }
  396.  
  397.     sfirst = screamfirst;
  398.     snext = screamnext;
  399.  
  400.     if (!sfirst || !snext)
  401.     DIE("do_study: out of memory");
  402.  
  403.     for (ch = 256; ch; --ch)
  404.     *sfirst++ = -1;
  405.     sfirst -= 256;
  406.  
  407.     while (--pos >= 0) {
  408.     ch = s[pos];
  409.     if (sfirst[ch] >= 0)
  410.         snext[pos] = sfirst[ch] - pos;
  411.     else
  412.         snext[pos] = -pos;
  413.     sfirst[ch] = pos;
  414.  
  415.     /* If there were any case insensitive searches, we must assume they
  416.      * all are.  This speeds up insensitive searches much more than
  417.      * it slows down sensitive ones.
  418.      */
  419.     if (sawi)
  420.         sfirst[fold[ch]] = pos;
  421.     }
  422.  
  423.     SvSCREAM_on(sv);
  424.     sv_magic(sv, Nullsv, 'g', Nullch, 0);    /* piggyback on m//g magic */
  425.     retval = 1;
  426.   ret:
  427.     XPUSHs(sv_2mortal(newSViv((I32)retval)));
  428.     RETURN;
  429. }
  430.  
  431. PP(pp_trans)
  432. {
  433.     dSP; dTARG;
  434.     SV *sv;
  435.  
  436.     if (op->op_flags & OPf_STACKED)
  437.     sv = POPs;
  438.     else {
  439.     sv = GvSV(defgv);
  440.     EXTEND(SP,1);
  441.     }
  442.     TARG = sv_newmortal();
  443.     PUSHi(do_trans(sv, op));
  444.     RETURN;
  445. }
  446.  
  447. /* Lvalue operators. */
  448.  
  449. PP(pp_schop)
  450. {
  451.     dSP; dTARGET;
  452.     do_chop(TARG, TOPs);
  453.     SETTARG;
  454.     RETURN;
  455. }
  456.  
  457. PP(pp_chop)
  458. {
  459.     dSP; dMARK; dTARGET;
  460.     while (SP > MARK)
  461.     do_chop(TARG, POPs);
  462.     PUSHTARG;
  463.     RETURN;
  464. }
  465.  
  466. PP(pp_schomp)
  467. {
  468.     dSP; dTARGET;
  469.     SETi(do_chomp(TOPs));
  470.     RETURN;
  471. }
  472.  
  473. PP(pp_chomp)
  474. {
  475.     dSP; dMARK; dTARGET;
  476.     register I32 count = 0;
  477.     
  478.     while (SP > MARK)
  479.     count += do_chomp(POPs);
  480.     PUSHi(count);
  481.     RETURN;
  482. }
  483.  
  484. PP(pp_defined)
  485. {
  486.     dSP;
  487.     register SV* sv;
  488.  
  489.     sv = POPs;
  490.     if (!sv || !SvANY(sv))
  491.     RETPUSHNO;
  492.     switch (SvTYPE(sv)) {
  493.     case SVt_PVAV:
  494.     if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
  495.         RETPUSHYES;
  496.     break;
  497.     case SVt_PVHV:
  498.     if (HvARRAY(sv) || SvRMAGICAL(sv))
  499.         RETPUSHYES;
  500.     break;
  501.     case SVt_PVCV:
  502.     if (CvROOT(sv) || CvXSUB(sv))
  503.         RETPUSHYES;
  504.     break;
  505.     default:
  506.     if (SvGMAGICAL(sv))
  507.         mg_get(sv);
  508.     if (SvOK(sv))
  509.         RETPUSHYES;
  510.     }
  511.     RETPUSHNO;
  512. }
  513.  
  514. PP(pp_undef)
  515. {
  516.     dSP;
  517.     SV *sv;
  518.  
  519.     if (!op->op_private)
  520.     RETPUSHUNDEF;
  521.  
  522.     sv = POPs;
  523.     if (!sv)
  524.     RETPUSHUNDEF;
  525.  
  526.     if (SvTHINKFIRST(sv)) {
  527.     if (SvREADONLY(sv))
  528.         RETPUSHUNDEF;
  529.     if (SvROK(sv))
  530.         sv_unref(sv);
  531.     }
  532.  
  533.     switch (SvTYPE(sv)) {
  534.     case SVt_NULL:
  535.     break;
  536.     case SVt_PVAV:
  537.     av_undef((AV*)sv);
  538.     break;
  539.     case SVt_PVHV:
  540.     hv_undef((HV*)sv);
  541.     break;
  542.     case SVt_PVCV:
  543.     cv_undef((CV*)sv);
  544.     sub_generation++;
  545.     break;
  546.     case SVt_PVGV:
  547.         if (SvFAKE(sv)) {
  548.             sv_setsv(sv, &sv_undef);
  549.             break;
  550.         }
  551.     default:
  552.     if (SvPOK(sv) && SvLEN(sv)) {
  553.         (void)SvOOK_off(sv);
  554.         Safefree(SvPVX(sv));
  555.         SvPV_set(sv, Nullch);
  556.         SvLEN_set(sv, 0);
  557.     }
  558.     (void)SvOK_off(sv);
  559.     SvSETMAGIC(sv);
  560.     }
  561.  
  562.     RETPUSHUNDEF;
  563. }
  564.  
  565. PP(pp_predec)
  566. {
  567.     dSP;
  568.     if (SvIOK(TOPs)) {
  569.     --SvIVX(TOPs);
  570.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  571.     }
  572.     else
  573.     sv_dec(TOPs);
  574.     SvSETMAGIC(TOPs);
  575.     return NORMAL;
  576. }
  577.  
  578. PP(pp_postinc)
  579. {
  580.     dSP; dTARGET;
  581.     sv_setsv(TARG, TOPs);
  582.     if (SvIOK(TOPs)) {
  583.     ++SvIVX(TOPs);
  584.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  585.     }
  586.     else
  587.     sv_inc(TOPs);
  588.     SvSETMAGIC(TOPs);
  589.     if (!SvOK(TARG))
  590.     sv_setiv(TARG, 0);
  591.     SETs(TARG);
  592.     return NORMAL;
  593. }
  594.  
  595. PP(pp_postdec)
  596. {
  597.     dSP; dTARGET;
  598.     sv_setsv(TARG, TOPs);
  599.     if (SvIOK(TOPs)) {
  600.     --SvIVX(TOPs);
  601.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  602.     }
  603.     else
  604.     sv_dec(TOPs);
  605.     SvSETMAGIC(TOPs);
  606.     SETs(TARG);
  607.     return NORMAL;
  608. }
  609.  
  610. /* Ordinary operators. */
  611.  
  612. PP(pp_pow)
  613. {
  614.     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); 
  615.     {
  616.       dPOPTOPnnrl;
  617.       SETn( pow( left, right) );
  618.       RETURN;
  619.     }
  620. }
  621.  
  622. PP(pp_multiply)
  623. {
  624.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  625.     {
  626.       dPOPTOPnnrl;
  627.       SETn( left * right );
  628.       RETURN;
  629.     }
  630. }
  631.  
  632. PP(pp_divide)
  633. {
  634.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  635.     {
  636.       dPOPnv;
  637.       if (value == 0.0)
  638.     DIE("Illegal division by zero");
  639. #ifdef SLOPPYDIVIDE
  640.       /* insure that 20./5. == 4. */
  641.       {
  642.     double x;
  643.     I32    k;
  644.     x =  POPn;
  645.     if ((double)I_32(x)     == x &&
  646.         (double)I_32(value) == value &&
  647.         (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
  648.         value = k;
  649.     } else {
  650.         value = x/value;
  651.     }
  652.       }
  653. #else
  654.       value = POPn / value;
  655. #endif
  656.       PUSHn( value );
  657.       RETURN;
  658.     }
  659. }
  660.  
  661. PP(pp_modulo)
  662. {
  663.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
  664.     {
  665.       register unsigned long tmpulong;
  666.       register long tmplong;
  667.       I32 value;
  668.  
  669.       tmpulong = (unsigned long) POPn;
  670.       if (tmpulong == 0L)
  671.     DIE("Illegal modulus zero");
  672.       value = TOPn;
  673.       if (value >= 0.0)
  674.     value = (I32)(((unsigned long)value) % tmpulong);
  675.       else {
  676.     tmplong = (long)value;
  677.     value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
  678.       }
  679.       SETi(value);
  680.       RETURN;
  681.     }
  682. }
  683.  
  684. PP(pp_repeat)
  685. {
  686.   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
  687.   {
  688.     register I32 count = POPi;
  689.     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
  690.     dMARK;
  691.     I32 items = SP - MARK;
  692.     I32 max;
  693.  
  694.     max = items * count;
  695.     MEXTEND(MARK, max);
  696.     if (count > 1) {
  697.         while (SP > MARK) {
  698.         if (*SP)
  699.             SvTEMP_off((*SP));
  700.         SP--;
  701.         }
  702.         MARK++;
  703.         repeatcpy((char*)(MARK + items), (char*)MARK,
  704.         items * sizeof(SV*), count - 1);
  705.         SP += max;
  706.     }
  707.     else if (count <= 0)
  708.         SP -= items;
  709.     }
  710.     else {    /* Note: mark already snarfed by pp_list */
  711.     SV *tmpstr;
  712.     STRLEN len;
  713.  
  714.     tmpstr = POPs;
  715.     if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
  716.         if (SvREADONLY(tmpstr) && curcop != &compiling)
  717.         DIE("Can't x= to readonly value");
  718.         if (SvROK(tmpstr))
  719.         sv_unref(tmpstr);
  720.     }
  721.     SvSetSV(TARG, tmpstr);
  722.     SvPV_force(TARG, len);
  723.     if (count >= 1) {
  724.         SvGROW(TARG, (count * len) + 1);
  725.         if (count > 1)
  726.         repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
  727.         SvCUR(TARG) *= count;
  728.         *SvEND(TARG) = '\0';
  729.         (void)SvPOK_only(TARG);
  730.     }
  731.     else
  732.         sv_setsv(TARG, &sv_no);
  733.     PUSHTARG;
  734.     }
  735.     RETURN;
  736.   }
  737. }
  738.  
  739. PP(pp_subtract)
  740. {
  741.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  742.     {
  743.       dPOPTOPnnrl;
  744.       SETn( left - right );
  745.       RETURN;
  746.     }
  747. }
  748.  
  749. PP(pp_left_shift)
  750. {
  751.     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
  752.     {
  753.         dPOPTOPiirl;
  754.         SETi( left << right );
  755.         RETURN;
  756.     }
  757. }
  758.  
  759. PP(pp_right_shift)
  760. {
  761.     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); 
  762.     {
  763.       dPOPTOPiirl;
  764.       SETi( left >> right );
  765.       RETURN;
  766.     }
  767. }
  768.  
  769. PP(pp_lt)
  770. {
  771.     dSP; tryAMAGICbinSET(lt,0); 
  772.     {
  773.       dPOPnv;
  774.       SETs((TOPn < value) ? &sv_yes : &sv_no);
  775.       RETURN;
  776.     }
  777. }
  778.  
  779. PP(pp_gt)
  780. {
  781.     dSP; tryAMAGICbinSET(gt,0); 
  782.     {
  783.       dPOPnv;
  784.       SETs((TOPn > value) ? &sv_yes : &sv_no);
  785.       RETURN;
  786.     }
  787. }
  788.  
  789. PP(pp_le)
  790. {
  791.     dSP; tryAMAGICbinSET(le,0); 
  792.     {
  793.       dPOPnv;
  794.       SETs((TOPn <= value) ? &sv_yes : &sv_no);
  795.       RETURN;
  796.     }
  797. }
  798.  
  799. PP(pp_ge)
  800. {
  801.     dSP; tryAMAGICbinSET(ge,0); 
  802.     {
  803.       dPOPnv;
  804.       SETs((TOPn >= value) ? &sv_yes : &sv_no);
  805.       RETURN;
  806.     }
  807. }
  808.  
  809. PP(pp_ne)
  810. {
  811.     dSP; tryAMAGICbinSET(ne,0); 
  812.     {
  813.       dPOPnv;
  814.       SETs((TOPn != value) ? &sv_yes : &sv_no);
  815.       RETURN;
  816.     }
  817. }
  818.  
  819. PP(pp_ncmp)
  820. {
  821.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  822.     {
  823.       dPOPTOPnnrl;
  824.       I32 value;
  825.  
  826.       if (left > right)
  827.     value = 1;
  828.       else if (left < right)
  829.     value = -1;
  830.       else
  831.     value = 0;
  832.       SETi(value);
  833.       RETURN;
  834.     }
  835. }
  836.  
  837. PP(pp_slt)
  838. {
  839.     dSP; tryAMAGICbinSET(slt,0); 
  840.     {
  841.       dPOPTOPssrl;
  842.       SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
  843.       RETURN;
  844.     }
  845. }
  846.  
  847. PP(pp_sgt)
  848. {
  849.     dSP; tryAMAGICbinSET(sgt,0); 
  850.     {
  851.       dPOPTOPssrl;
  852.       SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
  853.       RETURN;
  854.     }
  855. }
  856.  
  857. PP(pp_sle)
  858. {
  859.     dSP; tryAMAGICbinSET(sle,0); 
  860.     {
  861.       dPOPTOPssrl;
  862.       SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
  863.       RETURN;
  864.     }
  865. }
  866.  
  867. PP(pp_sge)
  868. {
  869.     dSP; tryAMAGICbinSET(sge,0); 
  870.     {
  871.       dPOPTOPssrl;
  872.       SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
  873.       RETURN;
  874.     }
  875. }
  876.  
  877. PP(pp_sne)
  878. {
  879.     dSP; tryAMAGICbinSET(sne,0); 
  880.     {
  881.       dPOPTOPssrl;
  882.       SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
  883.       RETURN;
  884.     }
  885. }
  886.  
  887. PP(pp_scmp)
  888. {
  889.     dSP; dTARGET;  tryAMAGICbin(scmp,0);
  890.     {
  891.       dPOPTOPssrl;
  892.       SETi( sv_cmp(left, right) );
  893.       RETURN;
  894.     }
  895. }
  896.  
  897. PP(pp_bit_and) {
  898.     dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
  899.     {
  900.       dPOPTOPssrl;
  901.       if (SvNIOKp(left) || SvNIOKp(right)) {
  902.     unsigned long value = U_L(SvNV(left));
  903.     value = value & U_L(SvNV(right));
  904.     SETn((double)value);
  905.       }
  906.       else {
  907.     do_vop(op->op_type, TARG, left, right);
  908.     SETTARG;
  909.       }
  910.       RETURN;
  911.     }
  912. }
  913.  
  914. PP(pp_bit_xor)
  915. {
  916.     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); 
  917.     {
  918.       dPOPTOPssrl;
  919.       if (SvNIOKp(left) || SvNIOKp(right)) {
  920.     unsigned long value = U_L(SvNV(left));
  921.     value = value ^ U_L(SvNV(right));
  922.     SETn((double)value);
  923.       }
  924.       else {
  925.     do_vop(op->op_type, TARG, left, right);
  926.     SETTARG;
  927.       }
  928.       RETURN;
  929.     }
  930. }
  931.  
  932. PP(pp_bit_or)
  933. {
  934.     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); 
  935.     {
  936.       dPOPTOPssrl;
  937.       if (SvNIOKp(left) || SvNIOKp(right)) {
  938.     unsigned long value = U_L(SvNV(left));
  939.     value = value | U_L(SvNV(right));
  940.     SETn((double)value);
  941.       }
  942.       else {
  943.     do_vop(op->op_type, TARG, left, right);
  944.     SETTARG;
  945.       }
  946.       RETURN;
  947.     }
  948. }
  949.  
  950. PP(pp_negate)
  951. {
  952.     dSP; dTARGET; tryAMAGICun(neg);
  953.     {
  954.     dTOPss;
  955.     if (SvGMAGICAL(sv))
  956.         mg_get(sv);
  957.     if (SvNIOKp(sv))
  958.         SETn(-SvNV(sv));
  959.     else if (SvPOKp(sv)) {
  960.         STRLEN len;
  961.         char *s = SvPV(sv, len);
  962.         if (isALPHA(*s) || *s == '_') {
  963.         sv_setpvn(TARG, "-", 1);
  964.         sv_catsv(TARG, sv);
  965.         }
  966.         else if (*s == '+' || *s == '-') {
  967.         sv_setsv(TARG, sv);
  968.         *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
  969.         }
  970.         else
  971.         sv_setnv(TARG, -SvNV(sv));
  972.         SETTARG;
  973.     }
  974.     else
  975.         SETn(-SvNV(sv));
  976.     }
  977.     RETURN;
  978. }
  979.  
  980. PP(pp_not)
  981. {
  982. #ifdef OVERLOAD
  983.     dSP; tryAMAGICunSET(not);
  984. #endif /* OVERLOAD */
  985.     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
  986.     return NORMAL;
  987. }
  988.  
  989. PP(pp_complement)
  990. {
  991.     dSP; dTARGET; tryAMAGICun(compl); 
  992.     {
  993.       dTOPss;
  994.       register I32 anum;
  995.  
  996.       if (SvNIOKp(sv)) {
  997.     IV iv = ~SvIV(sv);
  998.     if (iv < 0)
  999.         SETn( (double) ~U_L(SvNV(sv)) );
  1000.     else
  1001.         SETi( iv );
  1002.       }
  1003.       else {
  1004.     register char *tmps;
  1005.     register long *tmpl;
  1006.     STRLEN len;
  1007.  
  1008.     SvSetSV(TARG, sv);
  1009.     tmps = SvPV_force(TARG, len);
  1010.     anum = len;
  1011. #ifdef LIBERAL
  1012.     for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
  1013.         *tmps = ~*tmps;
  1014.     tmpl = (long*)tmps;
  1015.     for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
  1016.         *tmpl = ~*tmpl;
  1017.     tmps = (char*)tmpl;
  1018. #endif
  1019.     for ( ; anum > 0; anum--, tmps++)
  1020.         *tmps = ~*tmps;
  1021.  
  1022.     SETs(TARG);
  1023.       }
  1024.       RETURN;
  1025.     }
  1026. }
  1027.  
  1028. /* integer versions of some of the above */
  1029.  
  1030. PP(pp_i_multiply)
  1031. {
  1032.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  1033.     {
  1034.       dPOPTOPiirl;
  1035.       SETi( left * right );
  1036.       RETURN;
  1037.     }
  1038. }
  1039.  
  1040. PP(pp_i_divide)
  1041. {
  1042.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  1043.     {
  1044.       dPOPiv;
  1045.       if (value == 0)
  1046.     DIE("Illegal division by zero");
  1047.       value = POPi / value;
  1048.       PUSHi( value );
  1049.       RETURN;
  1050.     }
  1051. }
  1052.  
  1053. PP(pp_i_modulo)
  1054. {
  1055.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); 
  1056.     {
  1057.       dPOPTOPiirl;
  1058.       SETi( left % right );
  1059.       RETURN;
  1060.     }
  1061. }
  1062.  
  1063. PP(pp_i_add)
  1064. {
  1065.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  1066.     {
  1067.       dPOPTOPiirl;
  1068.       SETi( left + right );
  1069.       RETURN;
  1070.     }
  1071. }
  1072.  
  1073. PP(pp_i_subtract)
  1074. {
  1075.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  1076.     {
  1077.       dPOPTOPiirl;
  1078.       SETi( left - right );
  1079.       RETURN;
  1080.     }
  1081. }
  1082.  
  1083. PP(pp_i_lt)
  1084. {
  1085.     dSP; tryAMAGICbinSET(lt,0); 
  1086.     {
  1087.       dPOPTOPiirl;
  1088.       SETs((left < right) ? &sv_yes : &sv_no);
  1089.       RETURN;
  1090.     }
  1091. }
  1092.  
  1093. PP(pp_i_gt)
  1094. {
  1095.     dSP; tryAMAGICbinSET(gt,0); 
  1096.     {
  1097.       dPOPTOPiirl;
  1098.       SETs((left > right) ? &sv_yes : &sv_no);
  1099.       RETURN;
  1100.     }
  1101. }
  1102.  
  1103. PP(pp_i_le)
  1104. {
  1105.     dSP; tryAMAGICbinSET(le,0); 
  1106.     {
  1107.       dPOPTOPiirl;
  1108.       SETs((left <= right) ? &sv_yes : &sv_no);
  1109.       RETURN;
  1110.     }
  1111. }
  1112.  
  1113. PP(pp_i_ge)
  1114. {
  1115.     dSP; tryAMAGICbinSET(ge,0); 
  1116.     {
  1117.       dPOPTOPiirl;
  1118.       SETs((left >= right) ? &sv_yes : &sv_no);
  1119.       RETURN;
  1120.     }
  1121. }
  1122.  
  1123. PP(pp_i_eq)
  1124. {
  1125.     dSP; tryAMAGICbinSET(eq,0); 
  1126.     {
  1127.       dPOPTOPiirl;
  1128.       SETs((left == right) ? &sv_yes : &sv_no);
  1129.       RETURN;
  1130.     }
  1131. }
  1132.  
  1133. PP(pp_i_ne)
  1134. {
  1135.     dSP; tryAMAGICbinSET(ne,0); 
  1136.     {
  1137.       dPOPTOPiirl;
  1138.       SETs((left != right) ? &sv_yes : &sv_no);
  1139.       RETURN;
  1140.     }
  1141. }
  1142.  
  1143. PP(pp_i_ncmp)
  1144. {
  1145.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  1146.     {
  1147.       dPOPTOPiirl;
  1148.       I32 value;
  1149.  
  1150.       if (left > right)
  1151.     value = 1;
  1152.       else if (left < right)
  1153.     value = -1;
  1154.       else
  1155.     value = 0;
  1156.       SETi(value);
  1157.       RETURN;
  1158.     }
  1159. }
  1160.  
  1161. PP(pp_i_negate)
  1162. {
  1163.     dSP; dTARGET; tryAMAGICun(neg);
  1164.     SETi(-TOPi);
  1165.     RETURN;
  1166. }
  1167.  
  1168. /* High falutin' math. */
  1169.  
  1170. PP(pp_atan2)
  1171. {
  1172.     dSP; dTARGET; tryAMAGICbin(atan2,0); 
  1173.     {
  1174.       dPOPTOPnnrl;
  1175.       SETn(atan2(left, right));
  1176.       RETURN;
  1177.     }
  1178. }
  1179.  
  1180. PP(pp_sin)
  1181. {
  1182.     dSP; dTARGET; tryAMAGICun(sin);
  1183.     {
  1184.       double value;
  1185.       value = POPn;
  1186.       value = sin(value);
  1187.       XPUSHn(value);
  1188.       RETURN;
  1189.     }
  1190. }
  1191.  
  1192. PP(pp_cos)
  1193. {
  1194.     dSP; dTARGET; tryAMAGICun(cos);
  1195.     {
  1196.       double value;
  1197.       value = POPn;
  1198.       value = cos(value);
  1199.       XPUSHn(value);
  1200.       RETURN;
  1201.     }
  1202. }
  1203.  
  1204. PP(pp_rand)
  1205. {
  1206.     dSP; dTARGET;
  1207.     double value;
  1208.     if (MAXARG < 1)
  1209.     value = 1.0;
  1210.     else
  1211.     value = POPn;
  1212.     if (value == 0.0)
  1213.     value = 1.0;
  1214. #if RANDBITS == 31
  1215.     value = rand() * value / 2147483648.0;
  1216. #else
  1217. #if RANDBITS == 16
  1218.     value = rand() * value / 65536.0;
  1219. #else
  1220. #if RANDBITS == 15
  1221.     value = rand() * value / 32768.0;
  1222. #else
  1223.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1224. #endif
  1225. #endif
  1226. #endif
  1227.     XPUSHn(value);
  1228.     RETURN;
  1229. }
  1230.  
  1231. PP(pp_srand)
  1232. {
  1233.     dSP;
  1234.     I32 anum;
  1235.     Time_t when;
  1236.  
  1237.     if (MAXARG < 1) {
  1238.     (void)time(&when);
  1239.     anum = when;
  1240.     }
  1241.     else
  1242.     anum = POPi;
  1243.     (void)srand(anum);
  1244.     EXTEND(SP, 1);
  1245.     RETPUSHYES;
  1246. }
  1247.  
  1248. PP(pp_exp)
  1249. {
  1250.     dSP; dTARGET; tryAMAGICun(exp);
  1251.     {
  1252.       double value;
  1253.       value = POPn;
  1254.       value = exp(value);
  1255.       XPUSHn(value);
  1256.       RETURN;
  1257.     }
  1258. }
  1259.  
  1260. PP(pp_log)
  1261. {
  1262.     dSP; dTARGET; tryAMAGICun(log);
  1263.     {
  1264.       double value;
  1265.       value = POPn;
  1266.       if (value <= 0.0)
  1267.     DIE("Can't take log of %g", value);
  1268.       value = log(value);
  1269.       XPUSHn(value);
  1270.       RETURN;
  1271.     }
  1272. }
  1273.  
  1274. PP(pp_sqrt)
  1275. {
  1276.     dSP; dTARGET; tryAMAGICun(sqrt);
  1277.     {
  1278.       double value;
  1279.       value = POPn;
  1280.       if (value < 0.0)
  1281.     DIE("Can't take sqrt of %g", value);
  1282.       value = sqrt(value);
  1283.       XPUSHn(value);
  1284.       RETURN;
  1285.     }
  1286. }
  1287.  
  1288. PP(pp_int)
  1289. {
  1290.     dSP; dTARGET;
  1291.     double value;
  1292.     value = POPn;
  1293.     if (value >= 0.0)
  1294.     (void)modf(value, &value);
  1295.     else {
  1296.     (void)modf(-value, &value);
  1297.     value = -value;
  1298.     }
  1299.     XPUSHn(value);
  1300.     RETURN;
  1301. }
  1302.  
  1303. PP(pp_abs)
  1304. {
  1305.     dSP; dTARGET; tryAMAGICun(abs);
  1306.     {
  1307.       double value;
  1308.       value = POPn;
  1309.  
  1310.       if (value < 0.0)
  1311.     value = -value;
  1312.  
  1313.       XPUSHn(value);
  1314.       RETURN;
  1315.     }
  1316. }
  1317.  
  1318. PP(pp_hex)
  1319. {
  1320.     dSP; dTARGET;
  1321.     char *tmps;
  1322.     unsigned long value;
  1323.     I32 argtype;
  1324.  
  1325.     tmps = POPp;
  1326.     value = scan_hex(tmps, 99, &argtype);
  1327.     if ((IV)value >= 0)
  1328.     XPUSHi(value);
  1329.     else
  1330.     XPUSHn(U_V(value));
  1331.     RETURN;
  1332. }
  1333.  
  1334. PP(pp_oct)
  1335. {
  1336.     dSP; dTARGET;
  1337.     unsigned long value;
  1338.     I32 argtype;
  1339.     char *tmps;
  1340.  
  1341.     tmps = POPp;
  1342.     while (*tmps && isSPACE(*tmps))
  1343.     tmps++;
  1344.     if (*tmps == '0')
  1345.     tmps++;
  1346.     if (*tmps == 'x')
  1347.     value = scan_hex(++tmps, 99, &argtype);
  1348.     else
  1349.     value = scan_oct(tmps, 99, &argtype);
  1350.     if ((IV)value >= 0)
  1351.     XPUSHi(value);
  1352.     else
  1353.     XPUSHn(U_V(value));
  1354.     RETURN;
  1355. }
  1356.  
  1357. /* String stuff. */
  1358.  
  1359. PP(pp_length)
  1360. {
  1361.     dSP; dTARGET;
  1362.     SETi( sv_len(TOPs) );
  1363.     RETURN;
  1364. }
  1365.  
  1366. PP(pp_substr)
  1367. {
  1368.     dSP; dTARGET;
  1369.     SV *sv;
  1370.     I32 len;
  1371.     STRLEN curlen;
  1372.     I32 pos;
  1373.     I32 rem;
  1374.     I32 lvalue = op->op_flags & OPf_MOD;
  1375.     char *tmps;
  1376.     I32 arybase = curcop->cop_arybase;
  1377.  
  1378.     if (MAXARG > 2)
  1379.     len = POPi;
  1380.     pos = POPi - arybase;
  1381.     sv = POPs;
  1382.     tmps = SvPV(sv, curlen);
  1383.     if (pos < 0)
  1384.     pos += curlen + arybase;
  1385.     if (pos < 0 || pos > curlen) {
  1386.     if (dowarn || lvalue)
  1387.         warn("substr outside of string");
  1388.     RETPUSHUNDEF;
  1389.     }
  1390.     else {
  1391.     if (MAXARG < 3)
  1392.         len = curlen;
  1393.     else if (len < 0) {
  1394.         len += curlen - pos;
  1395.         if (len < 0)
  1396.         len = 0;
  1397.     }
  1398.     tmps += pos;
  1399.     rem = curlen - pos;    /* rem=how many bytes left*/
  1400.     if (rem > len)
  1401.         rem = len;
  1402.     sv_setpvn(TARG, tmps, rem);
  1403.     if (lvalue) {            /* it's an lvalue! */
  1404.         if (!SvGMAGICAL(sv))
  1405.         (void)SvPOK_only(sv);
  1406.         if (SvTYPE(TARG) < SVt_PVLV) {
  1407.         sv_upgrade(TARG, SVt_PVLV);
  1408.         sv_magic(TARG, Nullsv, 'x', Nullch, 0);
  1409.         }
  1410.  
  1411.         LvTYPE(TARG) = 's';
  1412.         LvTARG(TARG) = sv;
  1413.         LvTARGOFF(TARG) = pos;
  1414.         LvTARGLEN(TARG) = rem; 
  1415.     }
  1416.     }
  1417.     PUSHs(TARG);        /* avoid SvSETMAGIC here */
  1418.     RETURN;
  1419. }
  1420.  
  1421. PP(pp_vec)
  1422. {
  1423.     dSP; dTARGET;
  1424.     register I32 size = POPi;
  1425.     register I32 offset = POPi;
  1426.     register SV *src = POPs;
  1427.     I32 lvalue = op->op_flags & OPf_MOD;
  1428.     STRLEN srclen;
  1429.     unsigned char *s = (unsigned char*)SvPV(src, srclen);
  1430.     unsigned long retnum;
  1431.     I32 len;
  1432.  
  1433.     offset *= size;        /* turn into bit offset */
  1434.     len = (offset + size + 7) / 8;
  1435.     if (offset < 0 || size < 1)
  1436.     retnum = 0;
  1437.     else {
  1438.     if (lvalue) {                      /* it's an lvalue! */
  1439.         if (SvTYPE(TARG) < SVt_PVLV) {
  1440.         sv_upgrade(TARG, SVt_PVLV);
  1441.         sv_magic(TARG, Nullsv, 'v', Nullch, 0);
  1442.         }
  1443.  
  1444.         LvTYPE(TARG) = 'v';
  1445.         LvTARG(TARG) = src;
  1446.         LvTARGOFF(TARG) = offset; 
  1447.         LvTARGLEN(TARG) = size; 
  1448.     }
  1449.     if (len > srclen) {
  1450.         if (size <= 8)
  1451.         retnum = 0;
  1452.         else {
  1453.         offset >>= 3;
  1454.         if (size == 16) {
  1455.             if (offset >= srclen)
  1456.             retnum = 0;
  1457.             else
  1458.             retnum = (unsigned long) s[offset] << 8;
  1459.         }
  1460.         else if (size == 32) {
  1461.             if (offset >= srclen)
  1462.             retnum = 0;
  1463.             else if (offset + 1 >= srclen)
  1464.             retnum = (unsigned long) s[offset] << 24;
  1465.             else if (offset + 2 >= srclen)
  1466.             retnum = ((unsigned long) s[offset] << 24) +
  1467.                 ((unsigned long) s[offset + 1] << 16);
  1468.             else
  1469.             retnum = ((unsigned long) s[offset] << 24) +
  1470.                 ((unsigned long) s[offset + 1] << 16) +
  1471.                 (s[offset + 2] << 8);
  1472.         }
  1473.         }
  1474.     }
  1475.     else if (size < 8)
  1476.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1477.     else {
  1478.         offset >>= 3;
  1479.         if (size == 8)
  1480.         retnum = s[offset];
  1481.         else if (size == 16)
  1482.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1483.         else if (size == 32)
  1484.         retnum = ((unsigned long) s[offset] << 24) +
  1485.             ((unsigned long) s[offset + 1] << 16) +
  1486.             (s[offset + 2] << 8) + s[offset+3];
  1487.     }
  1488.     }
  1489.  
  1490.     sv_setiv(TARG, (I32)retnum);
  1491.     PUSHs(TARG);
  1492.     RETURN;
  1493. }
  1494.  
  1495. PP(pp_index)
  1496. {
  1497.     dSP; dTARGET;
  1498.     SV *big;
  1499.     SV *little;
  1500.     I32 offset;
  1501.     I32 retval;
  1502.     char *tmps;
  1503.     char *tmps2;
  1504.     STRLEN biglen;
  1505.     I32 arybase = curcop->cop_arybase;
  1506.  
  1507.     if (MAXARG < 3)
  1508.     offset = 0;
  1509.     else
  1510.     offset = POPi - arybase;
  1511.     little = POPs;
  1512.     big = POPs;
  1513.     tmps = SvPV(big, biglen);
  1514.     if (offset < 0)
  1515.     offset = 0;
  1516.     else if (offset > biglen)
  1517.     offset = biglen;
  1518.     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
  1519.       (unsigned char*)tmps + biglen, little)))
  1520.     retval = -1 + arybase;
  1521.     else
  1522.     retval = tmps2 - tmps + arybase;
  1523.     PUSHi(retval);
  1524.     RETURN;
  1525. }
  1526.  
  1527. PP(pp_rindex)
  1528. {
  1529.     dSP; dTARGET;
  1530.     SV *big;
  1531.     SV *little;
  1532.     STRLEN blen;
  1533.     STRLEN llen;
  1534.     SV *offstr;
  1535.     I32 offset;
  1536.     I32 retval;
  1537.     char *tmps;
  1538.     char *tmps2;
  1539.     I32 arybase = curcop->cop_arybase;
  1540.  
  1541.     if (MAXARG >= 3)
  1542.     offstr = POPs;
  1543.     little = POPs;
  1544.     big = POPs;
  1545.     tmps2 = SvPV(little, llen);
  1546.     tmps = SvPV(big, blen);
  1547.     if (MAXARG < 3)
  1548.     offset = blen;
  1549.     else
  1550.     offset = SvIV(offstr) - arybase + llen;
  1551.     if (offset < 0)
  1552.     offset = 0;
  1553.     else if (offset > blen)
  1554.     offset = blen;
  1555.     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
  1556.               tmps2, tmps2 + llen)))
  1557.     retval = -1 + arybase;
  1558.     else
  1559.     retval = tmps2 - tmps + arybase;
  1560.     PUSHi(retval);
  1561.     RETURN;
  1562. }
  1563.  
  1564. PP(pp_sprintf)
  1565. {
  1566.     dSP; dMARK; dORIGMARK; dTARGET;
  1567.     do_sprintf(TARG, SP-MARK, MARK+1);
  1568.     SP = ORIGMARK;
  1569.     PUSHTARG;
  1570.     RETURN;
  1571. }
  1572.  
  1573. PP(pp_ord)
  1574. {
  1575.     dSP; dTARGET;
  1576.     I32 value;
  1577.     char *tmps;
  1578.  
  1579. #ifndef I286
  1580.     tmps = POPp;
  1581.     value = (I32) (*tmps & 255);
  1582. #else
  1583.     I32 anum;
  1584.     tmps = POPp;
  1585.     anum = (I32) *tmps;
  1586.     value = (I32) (anum & 255);
  1587. #endif
  1588.     XPUSHi(value);
  1589.     RETURN;
  1590. }
  1591.  
  1592. PP(pp_chr)
  1593. {
  1594.     dSP; dTARGET;
  1595.     char *tmps;
  1596.  
  1597.     (void)SvUPGRADE(TARG,SVt_PV);
  1598.     SvGROW(TARG,2);
  1599.     SvCUR_set(TARG, 1);
  1600.     tmps = SvPVX(TARG);
  1601.     *tmps++ = POPi;
  1602.     *tmps = '\0';
  1603.     (void)SvPOK_only(TARG);
  1604.     XPUSHs(TARG);
  1605.     RETURN;
  1606. }
  1607.  
  1608. PP(pp_crypt)
  1609. {
  1610.     dSP; dTARGET; dPOPTOPssrl;
  1611. #ifdef HAS_CRYPT
  1612.     char *tmps = SvPV(left, na);
  1613. #ifdef FCRYPT
  1614.     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
  1615. #else
  1616.     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
  1617. #endif
  1618. #else
  1619.     DIE(
  1620.       "The crypt() function is unimplemented due to excessive paranoia.");
  1621. #endif
  1622.     SETs(TARG);
  1623.     RETURN;
  1624. }
  1625.  
  1626. PP(pp_ucfirst)
  1627. {
  1628.     dSP;
  1629.     SV *sv = TOPs;
  1630.     register char *s;
  1631.  
  1632.     if (!SvPADTMP(sv)) {
  1633.     dTARGET;
  1634.     sv_setsv(TARG, sv);
  1635.     sv = TARG;
  1636.     SETs(sv);
  1637.     }
  1638.     s = SvPV_force(sv, na);
  1639.     if (isLOWER(*s))
  1640.     *s = toUPPER(*s);
  1641.  
  1642.     RETURN;
  1643. }
  1644.  
  1645. PP(pp_lcfirst)
  1646. {
  1647.     dSP;
  1648.     SV *sv = TOPs;
  1649.     register char *s;
  1650.  
  1651.     if (!SvPADTMP(sv)) {
  1652.     dTARGET;
  1653.     sv_setsv(TARG, sv);
  1654.     sv = TARG;
  1655.     SETs(sv);
  1656.     }
  1657.     s = SvPV_force(sv, na);
  1658.     if (isUPPER(*s))
  1659.     *s = toLOWER(*s);
  1660.  
  1661.     SETs(sv);
  1662.     RETURN;
  1663. }
  1664.  
  1665. PP(pp_uc)
  1666. {
  1667.     dSP;
  1668.     SV *sv = TOPs;
  1669.     register char *s;
  1670.     register char *send;
  1671.     STRLEN len;
  1672.  
  1673.     if (!SvPADTMP(sv)) {
  1674.     dTARGET;
  1675.     sv_setsv(TARG, sv);
  1676.     sv = TARG;
  1677.     SETs(sv);
  1678.     }
  1679.     s = SvPV_force(sv, len);
  1680.     send = s + len;
  1681.     while (s < send) {
  1682.     if (isLOWER(*s))
  1683.         *s = toUPPER(*s);
  1684.     s++;
  1685.     }
  1686.     RETURN;
  1687. }
  1688.  
  1689. PP(pp_lc)
  1690. {
  1691.     dSP;
  1692.     SV *sv = TOPs;
  1693.     register char *s;
  1694.     register char *send;
  1695.     STRLEN len;
  1696.  
  1697.     if (!SvPADTMP(sv)) {
  1698.     dTARGET;
  1699.     sv_setsv(TARG, sv);
  1700.     sv = TARG;
  1701.     SETs(sv);
  1702.     }
  1703.     s = SvPV_force(sv, len);
  1704.     send = s + len;
  1705.     while (s < send) {
  1706.     if (isUPPER(*s))
  1707.         *s = toLOWER(*s);
  1708.     s++;
  1709.     }
  1710.     RETURN;
  1711. }
  1712.  
  1713. PP(pp_quotemeta)
  1714. {
  1715.     dSP; dTARGET;
  1716.     SV *sv = TOPs;
  1717.     STRLEN len;
  1718.     register char *s = SvPV(sv,len);
  1719.     register char *d;
  1720.  
  1721.     if (len) {
  1722.     (void)SvUPGRADE(TARG, SVt_PV);
  1723.     SvGROW(TARG, (len * 2) + 1);
  1724.     d = SvPVX(TARG);
  1725.     while (len--) {
  1726.         if (!isALNUM(*s))
  1727.         *d++ = '\\';
  1728.         *d++ = *s++;
  1729.     }
  1730.     *d = '\0';
  1731.     SvCUR_set(TARG, d - SvPVX(TARG));
  1732.     (void)SvPOK_only(TARG);
  1733.     }
  1734.     else
  1735.     sv_setpvn(TARG, s, len);
  1736.     SETs(TARG);
  1737.     RETURN;
  1738. }
  1739.  
  1740. /* Arrays. */
  1741.  
  1742. PP(pp_aslice)
  1743. {
  1744.     dSP; dMARK; dORIGMARK;
  1745.     register SV** svp;
  1746.     register AV* av = (AV*)POPs;
  1747.     register I32 lval = op->op_flags & OPf_MOD;
  1748.     I32 arybase = curcop->cop_arybase;
  1749.     I32 elem;
  1750.  
  1751.     if (SvTYPE(av) == SVt_PVAV) {
  1752.     if (lval && op->op_private & OPpLVAL_INTRO) {
  1753.         I32 max = -1;
  1754.         for (svp = mark + 1; svp <= sp; svp++) {
  1755.         elem = SvIVx(*svp);
  1756.         if (elem > max)
  1757.             max = elem;
  1758.         }
  1759.         if (max > AvMAX(av))
  1760.         av_extend(av, max);
  1761.     }
  1762.     while (++MARK <= SP) {
  1763.         elem = SvIVx(*MARK);
  1764.  
  1765.         if (elem > 0)
  1766.         elem -= arybase;
  1767.         svp = av_fetch(av, elem, lval);
  1768.         if (lval) {
  1769.         if (!svp || *svp == &sv_undef)
  1770.             DIE(no_aelem, elem);
  1771.         if (op->op_private & OPpLVAL_INTRO)
  1772.             save_svref(svp);
  1773.         }
  1774.         *MARK = svp ? *svp : &sv_undef;
  1775.     }
  1776.     }
  1777.     if (GIMME != G_ARRAY) {
  1778.     MARK = ORIGMARK;
  1779.     *++MARK = *SP;
  1780.     SP = MARK;
  1781.     }
  1782.     RETURN;
  1783. }
  1784.  
  1785. /* Associative arrays. */
  1786.  
  1787. PP(pp_each)
  1788. {
  1789.     dSP; dTARGET;
  1790.     HV *hash = (HV*)POPs;
  1791.     HE *entry;
  1792.     I32 i;
  1793.     char *tmps;
  1794.     
  1795.     PUTBACK;
  1796.     entry = hv_iternext(hash);                        /* might clobber stack_sp */
  1797.     SPAGAIN;
  1798.  
  1799.     EXTEND(SP, 2);
  1800.     if (entry) {
  1801.     tmps = hv_iterkey(entry, &i);                  /* won't clobber stack_sp */
  1802.     if (!i)
  1803.         tmps = "";
  1804.     PUSHs(sv_2mortal(newSVpv(tmps, i)));
  1805.     if (GIMME == G_ARRAY) {
  1806.         PUTBACK;
  1807.         sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
  1808.         SPAGAIN;
  1809.         PUSHs(TARG);
  1810.     }
  1811.     }
  1812.     else if (GIMME == G_SCALAR)
  1813.     RETPUSHUNDEF;
  1814.  
  1815.     RETURN;
  1816. }
  1817.  
  1818. PP(pp_values)
  1819. {
  1820.     return do_kv(ARGS);
  1821. }
  1822.  
  1823. PP(pp_keys)
  1824. {
  1825.     return do_kv(ARGS);
  1826. }
  1827.  
  1828. PP(pp_delete)
  1829. {
  1830.     dSP;
  1831.     SV *sv;
  1832.     SV *tmpsv = POPs;
  1833.     HV *hv = (HV*)POPs;
  1834.     char *tmps;
  1835.     STRLEN len;
  1836.     if (SvTYPE(hv) != SVt_PVHV) {
  1837.     DIE("Not a HASH reference");
  1838.     }
  1839.     tmps = SvPV(tmpsv, len);
  1840.     sv = hv_delete(hv, tmps, len,
  1841.     op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
  1842.     if (!sv)
  1843.     RETPUSHUNDEF;
  1844.     PUSHs(sv);
  1845.     RETURN;
  1846. }
  1847.  
  1848. PP(pp_exists)
  1849. {
  1850.     dSP;
  1851.     SV *tmpsv = POPs;
  1852.     HV *hv = (HV*)POPs;
  1853.     char *tmps;
  1854.     STRLEN len;
  1855.     if (SvTYPE(hv) != SVt_PVHV) {
  1856.     DIE("Not a HASH reference");
  1857.     }
  1858.     tmps = SvPV(tmpsv, len);
  1859.     if (hv_exists(hv, tmps, len))
  1860.     RETPUSHYES;
  1861.     RETPUSHNO;
  1862. }
  1863.  
  1864. PP(pp_hslice)
  1865. {
  1866.     dSP; dMARK; dORIGMARK;
  1867.     register SV **svp;
  1868.     register HV *hv = (HV*)POPs;
  1869.     register I32 lval = op->op_flags & OPf_MOD;
  1870.  
  1871.     if (SvTYPE(hv) == SVt_PVHV) {
  1872.     while (++MARK <= SP) {
  1873.         STRLEN keylen;
  1874.         char *key = SvPV(*MARK, keylen);
  1875.  
  1876.         svp = hv_fetch(hv, key, keylen, lval);
  1877.         if (lval) {
  1878.         if (!svp || *svp == &sv_undef)
  1879.             DIE(no_helem, key);
  1880.         if (op->op_private & OPpLVAL_INTRO)
  1881.             save_svref(svp);
  1882.         }
  1883.         *MARK = svp ? *svp : &sv_undef;
  1884.     }
  1885.     }
  1886.     if (GIMME != G_ARRAY) {
  1887.     MARK = ORIGMARK;
  1888.     *++MARK = *SP;
  1889.     SP = MARK;
  1890.     }
  1891.     RETURN;
  1892. }
  1893.  
  1894. /* List operators. */
  1895.  
  1896. PP(pp_list)
  1897. {
  1898.     dSP; dMARK;
  1899.     if (GIMME != G_ARRAY) {
  1900.     if (++MARK <= SP)
  1901.         *MARK = *SP;        /* unwanted list, return last item */
  1902.     else
  1903.         *MARK = &sv_undef;
  1904.     SP = MARK;
  1905.     }
  1906.     RETURN;
  1907. }
  1908.  
  1909. PP(pp_lslice)
  1910. {
  1911.     dSP;
  1912.     SV **lastrelem = stack_sp;
  1913.     SV **lastlelem = stack_base + POPMARK;
  1914.     SV **firstlelem = stack_base + POPMARK + 1;
  1915.     register SV **firstrelem = lastlelem + 1;
  1916.     I32 arybase = curcop->cop_arybase;
  1917.     I32 lval = op->op_flags & OPf_MOD;
  1918.     I32 is_something_there = lval;
  1919.  
  1920.     register I32 max = lastrelem - lastlelem;
  1921.     register SV **lelem;
  1922.     register I32 ix;
  1923.  
  1924.     if (GIMME != G_ARRAY) {
  1925.     ix = SvIVx(*lastlelem);
  1926.     if (ix < 0)
  1927.         ix += max;
  1928.     else
  1929.         ix -= arybase;
  1930.     if (ix < 0 || ix >= max)
  1931.         *firstlelem = &sv_undef;
  1932.     else
  1933.         *firstlelem = firstrelem[ix];
  1934.     SP = firstlelem;
  1935.     RETURN;
  1936.     }
  1937.  
  1938.     if (max == 0) {
  1939.     SP = firstlelem - 1;
  1940.     RETURN;
  1941.     }
  1942.  
  1943.     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
  1944.     ix = SvIVx(*lelem);
  1945.     if (ix < 0) {
  1946.         ix += max;
  1947.         if (ix < 0)
  1948.         *lelem = &sv_undef;
  1949.         else if (!(*lelem = firstrelem[ix]))
  1950.         *lelem = &sv_undef;
  1951.     }
  1952.     else {
  1953.         ix -= arybase;
  1954.         if (ix >= max || !(*lelem = firstrelem[ix]))
  1955.         *lelem = &sv_undef;
  1956.     }
  1957.     if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
  1958.         is_something_there = TRUE;
  1959.     }
  1960.     if (is_something_there)
  1961.     SP = lastlelem;
  1962.     else
  1963.     SP = firstlelem - 1;
  1964.     RETURN;
  1965. }
  1966.  
  1967. PP(pp_anonlist)
  1968. {
  1969.     dSP; dMARK;
  1970.     I32 items = SP - MARK;
  1971.     SP = MARK;
  1972.     XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
  1973.     RETURN;
  1974. }
  1975.  
  1976. PP(pp_anonhash)
  1977. {
  1978.     dSP; dMARK; dORIGMARK;
  1979.     STRLEN len;
  1980.     HV* hv = (HV*)sv_2mortal((SV*)newHV());
  1981.  
  1982.     while (MARK < SP) {
  1983.     SV* key = *++MARK;
  1984.     char *tmps;
  1985.     SV *val = NEWSV(46, 0);
  1986.     if (MARK < SP)
  1987.         sv_setsv(val, *++MARK);
  1988.     else
  1989.         warn("Odd number of elements in hash list");
  1990.     tmps = SvPV(key,len);
  1991.     (void)hv_store(hv,tmps,len,val,0);
  1992.     }
  1993.     SP = ORIGMARK;
  1994.     XPUSHs((SV*)hv);
  1995.     RETURN;
  1996. }
  1997.  
  1998. PP(pp_splice)
  1999. {
  2000.     dSP; dMARK; dORIGMARK;
  2001.     register AV *ary = (AV*)*++MARK;
  2002.     register SV **src;
  2003.     register SV **dst;
  2004.     register I32 i;
  2005.     register I32 offset;
  2006.     register I32 length;
  2007.     I32 newlen;
  2008.     I32 after;
  2009.     I32 diff;
  2010.     SV **tmparyval = 0;
  2011.  
  2012.     SP++;
  2013.  
  2014.     if (++MARK < SP) {
  2015.     offset = SvIVx(*MARK);
  2016.     if (offset < 0)
  2017.         offset += AvFILL(ary) + 1;
  2018.     else
  2019.         offset -= curcop->cop_arybase;
  2020.     if (++MARK < SP) {
  2021.         length = SvIVx(*MARK++);
  2022.         if (length < 0)
  2023.         length = 0;
  2024.     }
  2025.     else
  2026.         length = AvMAX(ary) + 1;        /* close enough to infinity */
  2027.     }
  2028.     else {
  2029.     offset = 0;
  2030.     length = AvMAX(ary) + 1;
  2031.     }
  2032.     if (offset < 0) {
  2033.     length += offset;
  2034.     offset = 0;
  2035.     if (length < 0)
  2036.         length = 0;
  2037.     }
  2038.     if (offset > AvFILL(ary) + 1)
  2039.     offset = AvFILL(ary) + 1;
  2040.     after = AvFILL(ary) + 1 - (offset + length);
  2041.     if (after < 0) {                /* not that much array */
  2042.     length += after;            /* offset+length now in array */
  2043.     after = 0;
  2044.     if (!AvALLOC(ary))
  2045.         av_extend(ary, 0);
  2046.     }
  2047.  
  2048.     /* At this point, MARK .. SP-1 is our new LIST */
  2049.  
  2050.     newlen = SP - MARK;
  2051.     diff = newlen - length;
  2052.  
  2053.     if (diff < 0) {                /* shrinking the area */
  2054.     if (newlen) {
  2055.         New(451, tmparyval, newlen, SV*);    /* so remember insertion */
  2056.         Copy(MARK, tmparyval, newlen, SV*);
  2057.     }
  2058.  
  2059.     MARK = ORIGMARK + 1;
  2060.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2061.         MEXTEND(MARK, length);
  2062.         Copy(AvARRAY(ary)+offset, MARK, length, SV*);
  2063.         if (AvREAL(ary)) {
  2064.         for (i = length, dst = MARK; i; i--)
  2065.             sv_2mortal(*dst++);    /* free them eventualy */
  2066.         }
  2067.         MARK += length - 1;
  2068.     }
  2069.     else {
  2070.         *MARK = AvARRAY(ary)[offset+length-1];
  2071.         if (AvREAL(ary)) {
  2072.         sv_2mortal(*MARK);
  2073.         for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
  2074.             SvREFCNT_dec(*dst++);    /* free them now */
  2075.         }
  2076.     }
  2077.     AvFILL(ary) += diff;
  2078.  
  2079.     /* pull up or down? */
  2080.  
  2081.     if (offset < after) {            /* easier to pull up */
  2082.         if (offset) {            /* esp. if nothing to pull */
  2083.         src = &AvARRAY(ary)[offset-1];
  2084.         dst = src - diff;        /* diff is negative */
  2085.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  2086.             *dst-- = *src--;
  2087.         }
  2088.         dst = AvARRAY(ary);
  2089.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
  2090.         AvMAX(ary) += diff;
  2091.     }
  2092.     else {
  2093.         if (after) {            /* anything to pull down? */
  2094.         src = AvARRAY(ary) + offset + length;
  2095.         dst = src + diff;        /* diff is negative */
  2096.         Move(src, dst, after, SV*);
  2097.         }
  2098.         dst = &AvARRAY(ary)[AvFILL(ary)+1];
  2099.                         /* avoid later double free */
  2100.     }
  2101.     i = -diff;
  2102.     while (i)
  2103.         dst[--i] = &sv_undef;
  2104.     
  2105.     if (newlen) {
  2106.         for (src = tmparyval, dst = AvARRAY(ary) + offset;
  2107.           newlen; newlen--) {
  2108.         *dst = NEWSV(46, 0);
  2109.         sv_setsv(*dst++, *src++);
  2110.         }
  2111.         Safefree(tmparyval);
  2112.     }
  2113.     }
  2114.     else {                    /* no, expanding (or same) */
  2115.     if (length) {
  2116.         New(452, tmparyval, length, SV*);    /* so remember deletion */
  2117.         Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
  2118.     }
  2119.  
  2120.     if (diff > 0) {                /* expanding */
  2121.  
  2122.         /* push up or down? */
  2123.  
  2124.         if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
  2125.         if (offset) {
  2126.             src = AvARRAY(ary);
  2127.             dst = src - diff;
  2128.             Move(src, dst, offset, SV*);
  2129.         }
  2130.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
  2131.         AvMAX(ary) += diff;
  2132.         AvFILL(ary) += diff;
  2133.         }
  2134.         else {
  2135.         if (AvFILL(ary) + diff >= AvMAX(ary))    /* oh, well */
  2136.             av_extend(ary, AvFILL(ary) + diff);
  2137.         AvFILL(ary) += diff;
  2138.  
  2139.         if (after) {
  2140.             dst = AvARRAY(ary) + AvFILL(ary);
  2141.             src = dst - diff;
  2142.             for (i = after; i; i--) {
  2143.             *dst-- = *src--;
  2144.             }
  2145.         }
  2146.         }
  2147.     }
  2148.  
  2149.     for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
  2150.         *dst = NEWSV(46, 0);
  2151.         sv_setsv(*dst++, *src++);
  2152.     }
  2153.     MARK = ORIGMARK + 1;
  2154.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2155.         if (length) {
  2156.         Copy(tmparyval, MARK, length, SV*);
  2157.         if (AvREAL(ary)) {
  2158.             for (i = length, dst = MARK; i; i--)
  2159.             sv_2mortal(*dst++);    /* free them eventualy */
  2160.         }
  2161.         Safefree(tmparyval);
  2162.         }
  2163.         MARK += length - 1;
  2164.     }
  2165.     else if (length--) {
  2166.         *MARK = tmparyval[length];
  2167.         if (AvREAL(ary)) {
  2168.         sv_2mortal(*MARK);
  2169.         while (length-- > 0)
  2170.             SvREFCNT_dec(tmparyval[length]);
  2171.         }
  2172.         Safefree(tmparyval);
  2173.     }
  2174.     else
  2175.         *MARK = &sv_undef;
  2176.     }
  2177.     SP = MARK;
  2178.     RETURN;
  2179. }
  2180.  
  2181. PP(pp_push)
  2182. {
  2183.     dSP; dMARK; dORIGMARK; dTARGET;
  2184.     register AV *ary = (AV*)*++MARK;
  2185.     register SV *sv = &sv_undef;
  2186.  
  2187.     for (++MARK; MARK <= SP; MARK++) {
  2188.     sv = NEWSV(51, 0);
  2189.     if (*MARK)
  2190.         sv_setsv(sv, *MARK);
  2191.     av_push(ary, sv);
  2192.     }
  2193.     SP = ORIGMARK;
  2194.     PUSHi( AvFILL(ary) + 1 );
  2195.     RETURN;
  2196. }
  2197.  
  2198. PP(pp_pop)
  2199. {
  2200.     dSP;
  2201.     AV *av = (AV*)POPs;
  2202.     SV *sv = av_pop(av);
  2203.     if (sv != &sv_undef && AvREAL(av))
  2204.     (void)sv_2mortal(sv);
  2205.     PUSHs(sv);
  2206.     RETURN;
  2207. }
  2208.  
  2209. PP(pp_shift)
  2210. {
  2211.     dSP;
  2212.     AV *av = (AV*)POPs;
  2213.     SV *sv = av_shift(av);
  2214.     EXTEND(SP, 1);
  2215.     if (!sv)
  2216.     RETPUSHUNDEF;
  2217.     if (sv != &sv_undef && AvREAL(av))
  2218.     (void)sv_2mortal(sv);
  2219.     PUSHs(sv);
  2220.     RETURN;
  2221. }
  2222.  
  2223. PP(pp_unshift)
  2224. {
  2225.     dSP; dMARK; dORIGMARK; dTARGET;
  2226.     register AV *ary = (AV*)*++MARK;
  2227.     register SV *sv;
  2228.     register I32 i = 0;
  2229.  
  2230.     av_unshift(ary, SP - MARK);
  2231.     while (MARK < SP) {
  2232.     sv = NEWSV(27, 0);
  2233.     sv_setsv(sv, *++MARK);
  2234.     (void)av_store(ary, i++, sv);
  2235.     }
  2236.  
  2237.     SP = ORIGMARK;
  2238.     PUSHi( AvFILL(ary) + 1 );
  2239.     RETURN;
  2240. }
  2241.  
  2242. PP(pp_reverse)
  2243. {
  2244.     dSP; dMARK;
  2245.     register SV *tmp;
  2246.     SV **oldsp = SP;
  2247.  
  2248.     if (GIMME == G_ARRAY) {
  2249.     MARK++;
  2250.     while (MARK < SP) {
  2251.         tmp = *MARK;
  2252.         *MARK++ = *SP;
  2253.         *SP-- = tmp;
  2254.     }
  2255.     SP = oldsp;
  2256.     }
  2257.     else {
  2258.     register char *up;
  2259.     register char *down;
  2260.     register I32 tmp;
  2261.     dTARGET;
  2262.     STRLEN len;
  2263.  
  2264.     if (SP - MARK > 1)
  2265.         do_join(TARG, &sv_no, MARK, SP);
  2266.     else
  2267.         sv_setsv(TARG, *SP);
  2268.     up = SvPV_force(TARG, len);
  2269.     if (len > 1) {
  2270.         down = SvPVX(TARG) + len - 1;
  2271.         while (down > up) {
  2272.         tmp = *up;
  2273.         *up++ = *down;
  2274.         *down-- = tmp;
  2275.         }
  2276.         (void)SvPOK_only(TARG);
  2277.     }
  2278.     SP = MARK + 1;
  2279.     SETTARG;
  2280.     }
  2281.     RETURN;
  2282. }
  2283.  
  2284. /* Explosives and implosives. */
  2285.  
  2286. PP(pp_unpack)
  2287. {
  2288.     dSP;
  2289.     dPOPPOPssrl;
  2290.     SV *sv;
  2291.     STRLEN llen;
  2292.     STRLEN rlen;
  2293.     register char *pat = SvPV(left, llen);
  2294.     register char *s = SvPV(right, rlen);
  2295.     char *strend = s + rlen;
  2296.     char *strbeg = s;
  2297.     register char *patend = pat + llen;
  2298.     I32 datumtype;
  2299.     register I32 len;
  2300.     register I32 bits;
  2301.  
  2302.     /* These must not be in registers: */
  2303.     I16 ashort;
  2304.     int aint;
  2305.     I32 along;
  2306. #ifdef HAS_QUAD
  2307.     Quad_t aquad;
  2308. #endif
  2309.     U16 aushort;
  2310.     unsigned int auint;
  2311.     U32 aulong;
  2312. #ifdef HAS_QUAD
  2313.     unsigned Quad_t auquad;
  2314. #endif
  2315.     char *aptr;
  2316.     float afloat;
  2317.     double adouble;
  2318.     I32 checksum = 0;
  2319.     register U32 culong;
  2320.     double cdouble;
  2321.     static char* bitcount = 0;
  2322.  
  2323.     if (GIMME != G_ARRAY) {        /* arrange to do first one only */
  2324.     /*SUPPRESS 530*/
  2325.     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  2326.     if (strchr("aAbBhHP", *patend) || *pat == '%') {
  2327.         patend++;
  2328.         while (isDIGIT(*patend) || *patend == '*')
  2329.         patend++;
  2330.     }
  2331.     else
  2332.         patend++;
  2333.     }
  2334.     while (pat < patend) {
  2335.       reparse:
  2336.     datumtype = *pat++;
  2337.     if (pat >= patend)
  2338.         len = 1;
  2339.     else if (*pat == '*') {
  2340.         len = strend - strbeg;    /* long enough */
  2341.         pat++;
  2342.     }
  2343.     else if (isDIGIT(*pat)) {
  2344.         len = *pat++ - '0';
  2345.         while (isDIGIT(*pat))
  2346.         len = (len * 10) + (*pat++ - '0');
  2347.     }
  2348.     else
  2349.         len = (datumtype != '@');
  2350.     switch(datumtype) {
  2351.     default:
  2352.         break;
  2353.     case '%':
  2354.         if (len == 1 && pat[-1] != '1')
  2355.         len = 16;
  2356.         checksum = len;
  2357.         culong = 0;
  2358.         cdouble = 0;
  2359.         if (pat < patend)
  2360.         goto reparse;
  2361.         break;
  2362.     case '@':
  2363.         if (len > strend - strbeg)
  2364.         DIE("@ outside of string");
  2365.         s = strbeg + len;
  2366.         break;
  2367.     case 'X':
  2368.         if (len > s - strbeg)
  2369.         DIE("X outside of string");
  2370.         s -= len;
  2371.         break;
  2372.     case 'x':
  2373.         if (len > strend - s)
  2374.         DIE("x outside of string");
  2375.         s += len;
  2376.         break;
  2377.     case 'A':
  2378.     case 'a':
  2379.         if (len > strend - s)
  2380.         len = strend - s;
  2381.         if (checksum)
  2382.         goto uchar_checksum;
  2383.         sv = NEWSV(35, len);
  2384.         sv_setpvn(sv, s, len);
  2385.         s += len;
  2386.         if (datumtype == 'A') {
  2387.         aptr = s;    /* borrow register */
  2388.         s = SvPVX(sv) + len - 1;
  2389.         while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
  2390.             s--;
  2391.         *++s = '\0';
  2392.         SvCUR_set(sv, s - SvPVX(sv));
  2393.         s = aptr;    /* unborrow register */
  2394.         }
  2395.         XPUSHs(sv_2mortal(sv));
  2396.         break;
  2397.     case 'B':
  2398.     case 'b':
  2399.         if (pat[-1] == '*' || len > (strend - s) * 8)
  2400.         len = (strend - s) * 8;
  2401.         if (checksum) {
  2402.         if (!bitcount) {
  2403.             Newz(601, bitcount, 256, char);
  2404.             for (bits = 1; bits < 256; bits++) {
  2405.             if (bits & 1)    bitcount[bits]++;
  2406.             if (bits & 2)    bitcount[bits]++;
  2407.             if (bits & 4)    bitcount[bits]++;
  2408.             if (bits & 8)    bitcount[bits]++;
  2409.             if (bits & 16)    bitcount[bits]++;
  2410.             if (bits & 32)    bitcount[bits]++;
  2411.             if (bits & 64)    bitcount[bits]++;
  2412.             if (bits & 128)    bitcount[bits]++;
  2413.             }
  2414.         }
  2415.         while (len >= 8) {
  2416.             culong += bitcount[*(unsigned char*)s++];
  2417.             len -= 8;
  2418.         }
  2419.         if (len) {
  2420.             bits = *s;
  2421.             if (datumtype == 'b') {
  2422.             while (len-- > 0) {
  2423.                 if (bits & 1) culong++;
  2424.                 bits >>= 1;
  2425.             }
  2426.             }
  2427.             else {
  2428.             while (len-- > 0) {
  2429.                 if (bits & 128) culong++;
  2430.                 bits <<= 1;
  2431.             }
  2432.             }
  2433.         }
  2434.         break;
  2435.         }
  2436.         sv = NEWSV(35, len + 1);
  2437.         SvCUR_set(sv, len);
  2438.         SvPOK_on(sv);
  2439.         aptr = pat;            /* borrow register */
  2440.         pat = SvPVX(sv);
  2441.         if (datumtype == 'b') {
  2442.         aint = len;
  2443.         for (len = 0; len < aint; len++) {
  2444.             if (len & 7)        /*SUPPRESS 595*/
  2445.             bits >>= 1;
  2446.             else
  2447.             bits = *s++;
  2448.             *pat++ = '0' + (bits & 1);
  2449.         }
  2450.         }
  2451.         else {
  2452.         aint = len;
  2453.         for (len = 0; len < aint; len++) {
  2454.             if (len & 7)
  2455.             bits <<= 1;
  2456.             else
  2457.             bits = *s++;
  2458.             *pat++ = '0' + ((bits & 128) != 0);
  2459.         }
  2460.         }
  2461.         *pat = '\0';
  2462.         pat = aptr;            /* unborrow register */
  2463.         XPUSHs(sv_2mortal(sv));
  2464.         break;
  2465.     case 'H':
  2466.     case 'h':
  2467.         if (pat[-1] == '*' || len > (strend - s) * 2)
  2468.         len = (strend - s) * 2;
  2469.         sv = NEWSV(35, len + 1);
  2470.         SvCUR_set(sv, len);
  2471.         SvPOK_on(sv);
  2472.         aptr = pat;            /* borrow register */
  2473.         pat = SvPVX(sv);
  2474.         if (datumtype == 'h') {
  2475.         aint = len;
  2476.         for (len = 0; len < aint; len++) {
  2477.             if (len & 1)
  2478.             bits >>= 4;
  2479.             else
  2480.             bits = *s++;
  2481.             *pat++ = hexdigit[bits & 15];
  2482.         }
  2483.         }
  2484.         else {
  2485.         aint = len;
  2486.         for (len = 0; len < aint; len++) {
  2487.             if (len & 1)
  2488.             bits <<= 4;
  2489.             else
  2490.             bits = *s++;
  2491.             *pat++ = hexdigit[(bits >> 4) & 15];
  2492.         }
  2493.         }
  2494.         *pat = '\0';
  2495.         pat = aptr;            /* unborrow register */
  2496.         XPUSHs(sv_2mortal(sv));
  2497.         break;
  2498.     case 'c':
  2499.         if (len > strend - s)
  2500.         len = strend - s;
  2501.         if (checksum) {
  2502.         while (len-- > 0) {
  2503.             aint = *s++;
  2504.             if (aint >= 128)    /* fake up signed chars */
  2505.             aint -= 256;
  2506.             culong += aint;
  2507.         }
  2508.         }
  2509.         else {
  2510.         EXTEND(SP, len);
  2511.         while (len-- > 0) {
  2512.             aint = *s++;
  2513.             if (aint >= 128)    /* fake up signed chars */
  2514.             aint -= 256;
  2515.             sv = NEWSV(36, 0);
  2516.             sv_setiv(sv, (I32)aint);
  2517.             PUSHs(sv_2mortal(sv));
  2518.         }
  2519.         }
  2520.         break;
  2521.     case 'C':
  2522.         if (len > strend - s)
  2523.         len = strend - s;
  2524.         if (checksum) {
  2525.           uchar_checksum:
  2526.         while (len-- > 0) {
  2527.             auint = *s++ & 255;
  2528.             culong += auint;
  2529.         }
  2530.         }
  2531.         else {
  2532.         EXTEND(SP, len);
  2533.         while (len-- > 0) {
  2534.             auint = *s++ & 255;
  2535.             sv = NEWSV(37, 0);
  2536.             sv_setiv(sv, (I32)auint);
  2537.             PUSHs(sv_2mortal(sv));
  2538.         }
  2539.         }
  2540.         break;
  2541.     case 's':
  2542.         along = (strend - s) / sizeof(I16);
  2543.         if (len > along)
  2544.         len = along;
  2545.         if (checksum) {
  2546.         while (len-- > 0) {
  2547.             Copy(s, &ashort, 1, I16);
  2548.             s += sizeof(I16);
  2549.             culong += ashort;
  2550.         }
  2551.         }
  2552.         else {
  2553.         EXTEND(SP, len);
  2554.         while (len-- > 0) {
  2555.             Copy(s, &ashort, 1, I16);
  2556.             s += sizeof(I16);
  2557.             sv = NEWSV(38, 0);
  2558.             sv_setiv(sv, (I32)ashort);
  2559.             PUSHs(sv_2mortal(sv));
  2560.         }
  2561.         }
  2562.         break;
  2563.     case 'v':
  2564.     case 'n':
  2565.     case 'S':
  2566.         along = (strend - s) / sizeof(U16);
  2567.         if (len > along)
  2568.         len = along;
  2569.         if (checksum) {
  2570.         while (len-- > 0) {
  2571.             Copy(s, &aushort, 1, U16);
  2572.             s += sizeof(U16);
  2573. #ifdef HAS_NTOHS
  2574.             if (datumtype == 'n')
  2575.             aushort = ntohs(aushort);
  2576. #endif
  2577. #ifdef HAS_VTOHS
  2578.             if (datumtype == 'v')
  2579.             aushort = vtohs(aushort);
  2580. #endif
  2581.             culong += aushort;
  2582.         }
  2583.         }
  2584.         else {
  2585.         EXTEND(SP, len);
  2586.         while (len-- > 0) {
  2587.             Copy(s, &aushort, 1, U16);
  2588.             s += sizeof(U16);
  2589.             sv = NEWSV(39, 0);
  2590. #ifdef HAS_NTOHS
  2591.             if (datumtype == 'n')
  2592.             aushort = ntohs(aushort);
  2593. #endif
  2594. #ifdef HAS_VTOHS
  2595.             if (datumtype == 'v')
  2596.             aushort = vtohs(aushort);
  2597. #endif
  2598.             sv_setiv(sv, (I32)aushort);
  2599.             PUSHs(sv_2mortal(sv));
  2600.         }
  2601.         }
  2602.         break;
  2603.     case 'i':
  2604.         along = (strend - s) / sizeof(int);
  2605.         if (len > along)
  2606.         len = along;
  2607.         if (checksum) {
  2608.         while (len-- > 0) {
  2609.             Copy(s, &aint, 1, int);
  2610.             s += sizeof(int);
  2611.             if (checksum > 32)
  2612.             cdouble += (double)aint;
  2613.             else
  2614.             culong += aint;
  2615.         }
  2616.         }
  2617.         else {
  2618.         EXTEND(SP, len);
  2619.         while (len-- > 0) {
  2620.             Copy(s, &aint, 1, int);
  2621.             s += sizeof(int);
  2622.             sv = NEWSV(40, 0);
  2623.             sv_setiv(sv, (I32)aint);
  2624.             PUSHs(sv_2mortal(sv));
  2625.         }
  2626.         }
  2627.         break;
  2628.     case 'I':
  2629.         along = (strend - s) / sizeof(unsigned int);
  2630.         if (len > along)
  2631.         len = along;
  2632.         if (checksum) {
  2633.         while (len-- > 0) {
  2634.             Copy(s, &auint, 1, unsigned int);
  2635.             s += sizeof(unsigned int);
  2636.             if (checksum > 32)
  2637.             cdouble += (double)auint;
  2638.             else
  2639.             culong += auint;
  2640.         }
  2641.         }
  2642.         else {
  2643.         EXTEND(SP, len);
  2644.         while (len-- > 0) {
  2645.             Copy(s, &auint, 1, unsigned int);
  2646.             s += sizeof(unsigned int);
  2647.             sv = NEWSV(41, 0);
  2648.             sv_setiv(sv, (I32)auint);
  2649.             PUSHs(sv_2mortal(sv));
  2650.         }
  2651.         }
  2652.         break;
  2653.     case 'l':
  2654.         along = (strend - s) / sizeof(I32);
  2655.         if (len > along)
  2656.         len = along;
  2657.         if (checksum) {
  2658.         while (len-- > 0) {
  2659.             Copy(s, &along, 1, I32);
  2660.             s += sizeof(I32);
  2661.             if (checksum > 32)
  2662.             cdouble += (double)along;
  2663.             else
  2664.             culong += along;
  2665.         }
  2666.         }
  2667.         else {
  2668.         EXTEND(SP, len);
  2669.         while (len-- > 0) {
  2670.             Copy(s, &along, 1, I32);
  2671.             s += sizeof(I32);
  2672.             sv = NEWSV(42, 0);
  2673.             sv_setiv(sv, (I32)along);
  2674.             PUSHs(sv_2mortal(sv));
  2675.         }
  2676.         }
  2677.         break;
  2678.     case 'V':
  2679.     case 'N':
  2680.     case 'L':
  2681.         along = (strend - s) / sizeof(U32);
  2682.         if (len > along)
  2683.         len = along;
  2684.         if (checksum) {
  2685.         while (len-- > 0) {
  2686.             Copy(s, &aulong, 1, U32);
  2687.             s += sizeof(U32);
  2688. #ifdef HAS_NTOHL
  2689.             if (datumtype == 'N')
  2690.             aulong = ntohl(aulong);
  2691. #endif
  2692. #ifdef HAS_VTOHL
  2693.             if (datumtype == 'V')
  2694.             aulong = vtohl(aulong);
  2695. #endif
  2696.             if (checksum > 32)
  2697.             cdouble += (double)aulong;
  2698.             else
  2699.             culong += aulong;
  2700.         }
  2701.         }
  2702.         else {
  2703.         EXTEND(SP, len);
  2704.         while (len-- > 0) {
  2705.             Copy(s, &aulong, 1, U32);
  2706.             s += sizeof(U32);
  2707.             sv = NEWSV(43, 0);
  2708. #ifdef HAS_NTOHL
  2709.             if (datumtype == 'N')
  2710.             aulong = ntohl(aulong);
  2711. #endif
  2712. #ifdef HAS_VTOHL
  2713.             if (datumtype == 'V')
  2714.             aulong = vtohl(aulong);
  2715. #endif
  2716.             sv_setnv(sv, (double)aulong);
  2717.             PUSHs(sv_2mortal(sv));
  2718.         }
  2719.         }
  2720.         break;
  2721.     case 'p':
  2722.         along = (strend - s) / sizeof(char*);
  2723.         if (len > along)
  2724.         len = along;
  2725.         EXTEND(SP, len);
  2726.         while (len-- > 0) {
  2727.         if (sizeof(char*) > strend - s)
  2728.             break;
  2729.         else {
  2730.             Copy(s, &aptr, 1, char*);
  2731.             s += sizeof(char*);
  2732.         }
  2733.         sv = NEWSV(44, 0);
  2734.         if (aptr)
  2735.             sv_setpv(sv, aptr);
  2736.         PUSHs(sv_2mortal(sv));
  2737.         }
  2738.         break;
  2739.     case 'P':
  2740.         EXTEND(SP, 1);
  2741.         if (sizeof(char*) > strend - s)
  2742.         break;
  2743.         else {
  2744.         Copy(s, &aptr, 1, char*);
  2745.         s += sizeof(char*);
  2746.         }
  2747.         sv = NEWSV(44, 0);
  2748.         if (aptr)
  2749.         sv_setpvn(sv, aptr, len);
  2750.         PUSHs(sv_2mortal(sv));
  2751.         break;
  2752. #ifdef HAS_QUAD
  2753.     case 'q':
  2754.         EXTEND(SP, len);
  2755.         while (len-- > 0) {
  2756.         if (s + sizeof(Quad_t) > strend)
  2757.             aquad = 0;
  2758.         else {
  2759.             Copy(s, &aquad, 1, Quad_t);
  2760.             s += sizeof(Quad_t);
  2761.         }
  2762.         sv = NEWSV(42, 0);
  2763.         sv_setiv(sv, (IV)aquad);
  2764.         PUSHs(sv_2mortal(sv));
  2765.         }
  2766.         break;
  2767.     case 'Q':
  2768.         EXTEND(SP, len);
  2769.         while (len-- > 0) {
  2770.         if (s + sizeof(unsigned Quad_t) > strend)
  2771.             auquad = 0;
  2772.         else {
  2773.             Copy(s, &auquad, 1, unsigned Quad_t);
  2774.             s += sizeof(unsigned Quad_t);
  2775.         }
  2776.         sv = NEWSV(43, 0);
  2777.         sv_setiv(sv, (IV)auquad);
  2778.         PUSHs(sv_2mortal(sv));
  2779.         }
  2780.         break;
  2781. #endif
  2782.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  2783.     case 'f':
  2784.     case 'F':
  2785.         along = (strend - s) / sizeof(float);
  2786.         if (len > along)
  2787.         len = along;
  2788.         if (checksum) {
  2789.         while (len-- > 0) {
  2790.             Copy(s, &afloat, 1, float);
  2791.             s += sizeof(float);
  2792.             cdouble += afloat;
  2793.         }
  2794.         }
  2795.         else {
  2796.         EXTEND(SP, len);
  2797.         while (len-- > 0) {
  2798.             Copy(s, &afloat, 1, float);
  2799.             s += sizeof(float);
  2800.             sv = NEWSV(47, 0);
  2801.             sv_setnv(sv, (double)afloat);
  2802.             PUSHs(sv_2mortal(sv));
  2803.         }
  2804.         }
  2805.         break;
  2806.     case 'd':
  2807.     case 'D':
  2808.         along = (strend - s) / sizeof(double);
  2809.         if (len > along)
  2810.         len = along;
  2811.         if (checksum) {
  2812.         while (len-- > 0) {
  2813.             Copy(s, &adouble, 1, double);
  2814.             s += sizeof(double);
  2815.             cdouble += adouble;
  2816.         }
  2817.         }
  2818.         else {
  2819.         EXTEND(SP, len);
  2820.         while (len-- > 0) {
  2821.             Copy(s, &adouble, 1, double);
  2822.             s += sizeof(double);
  2823.             sv = NEWSV(48, 0);
  2824.             sv_setnv(sv, (double)adouble);
  2825.             PUSHs(sv_2mortal(sv));
  2826.         }
  2827.         }
  2828.         break;
  2829.     case 'u':
  2830.         along = (strend - s) * 3 / 4;
  2831.         sv = NEWSV(42, along);
  2832.         while (s < strend && *s > ' ' && *s < 'a') {
  2833.         I32 a, b, c, d;
  2834.         char hunk[4];
  2835.  
  2836.         hunk[3] = '\0';
  2837.         len = (*s++ - ' ') & 077;
  2838.         while (len > 0) {
  2839.             if (s < strend && *s >= ' ')
  2840.             a = (*s++ - ' ') & 077;
  2841.             else
  2842.             a = 0;
  2843.             if (s < strend && *s >= ' ')
  2844.             b = (*s++ - ' ') & 077;
  2845.             else
  2846.             b = 0;
  2847.             if (s < strend && *s >= ' ')
  2848.             c = (*s++ - ' ') & 077;
  2849.             else
  2850.             c = 0;
  2851.             if (s < strend && *s >= ' ')
  2852.             d = (*s++ - ' ') & 077;
  2853.             else
  2854.             d = 0;
  2855.             hunk[0] = a << 2 | b >> 4;
  2856.             hunk[1] = b << 4 | c >> 2;
  2857.             hunk[2] = c << 6 | d;
  2858.             sv_catpvn(sv, hunk, len > 3 ? 3 : len);
  2859.             len -= 3;
  2860.         }
  2861.         if (*s == '\n')
  2862.             s++;
  2863.         else if (s[1] == '\n')        /* possible checksum byte */
  2864.             s += 2;
  2865.         }
  2866.         XPUSHs(sv_2mortal(sv));
  2867.         break;
  2868.     }
  2869.     if (checksum) {
  2870.         sv = NEWSV(42, 0);
  2871.         if (strchr("fFdD", datumtype) ||
  2872.           (checksum > 32 && strchr("iIlLN", datumtype)) ) {
  2873.         double trouble;
  2874.  
  2875.         adouble = 1.0;
  2876.         while (checksum >= 16) {
  2877.             checksum -= 16;
  2878.             adouble *= 65536.0;
  2879.         }
  2880.         while (checksum >= 4) {
  2881.             checksum -= 4;
  2882.             adouble *= 16.0;
  2883.         }
  2884.         while (checksum--)
  2885.             adouble *= 2.0;
  2886.         along = (1 << checksum) - 1;
  2887.         while (cdouble < 0.0)
  2888.             cdouble += adouble;
  2889.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  2890.         sv_setnv(sv, cdouble);
  2891.         }
  2892.         else {
  2893.         if (checksum < 32) {
  2894.             along = (1 << checksum) - 1;
  2895.             culong &= (U32)along;
  2896.         }
  2897.         sv_setnv(sv, (double)culong);
  2898.         }
  2899.         XPUSHs(sv_2mortal(sv));
  2900.         checksum = 0;
  2901.     }
  2902.     }
  2903.     RETURN;
  2904. }
  2905.  
  2906. static void
  2907. doencodes(sv, s, len)
  2908. register SV *sv;
  2909. register char *s;
  2910. register I32 len;
  2911. {
  2912.     char hunk[5];
  2913.  
  2914.     *hunk = len + ' ';
  2915.     sv_catpvn(sv, hunk, 1);
  2916.     hunk[4] = '\0';
  2917.     while (len > 0) {
  2918.     hunk[0] = ' ' + (077 & (*s >> 2));
  2919.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  2920.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  2921.     hunk[3] = ' ' + (077 & (s[2] & 077));
  2922.     sv_catpvn(sv, hunk, 4);
  2923.     s += 3;
  2924.     len -= 3;
  2925.     }
  2926.     for (s = SvPVX(sv); *s; s++) {
  2927.     if (*s == ' ')
  2928.         *s = '`';
  2929.     }
  2930.     sv_catpvn(sv, "\n", 1);
  2931. }
  2932.  
  2933. PP(pp_pack)
  2934. {
  2935.     dSP; dMARK; dORIGMARK; dTARGET;
  2936.     register SV *cat = TARG;
  2937.     register I32 items;
  2938.     STRLEN fromlen;
  2939.     register char *pat = SvPVx(*++MARK, fromlen);
  2940.     register char *patend = pat + fromlen;
  2941.     register I32 len;
  2942.     I32 datumtype;
  2943.     SV *fromstr;
  2944.     /*SUPPRESS 442*/
  2945.     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
  2946.     static char *space10 = "          ";
  2947.  
  2948.     /* These must not be in registers: */
  2949.     char achar;
  2950.     I16 ashort;
  2951.     int aint;
  2952.     unsigned int auint;
  2953.     I32 along;
  2954.     U32 aulong;
  2955. #ifdef HAS_QUAD
  2956.     Quad_t aquad;
  2957.     unsigned Quad_t auquad;
  2958. #endif
  2959.     char *aptr;
  2960.     float afloat;
  2961.     double adouble;
  2962.  
  2963.     items = SP - MARK;
  2964.     MARK++;
  2965.     sv_setpvn(cat, "", 0);
  2966.     while (pat < patend) {
  2967. #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
  2968.     datumtype = *pat++;
  2969.     if (*pat == '*') {
  2970.         len = strchr("@Xxu", datumtype) ? 0 : items;
  2971.         pat++;
  2972.     }
  2973.     else if (isDIGIT(*pat)) {
  2974.         len = *pat++ - '0';
  2975.         while (isDIGIT(*pat))
  2976.         len = (len * 10) + (*pat++ - '0');
  2977.     }
  2978.     else
  2979.         len = 1;
  2980.     switch(datumtype) {
  2981.     default:
  2982.         break;
  2983.     case '%':
  2984.         DIE("%% may only be used in unpack");
  2985.     case '@':
  2986.         len -= SvCUR(cat);
  2987.         if (len > 0)
  2988.         goto grow;
  2989.         len = -len;
  2990.         if (len > 0)
  2991.         goto shrink;
  2992.         break;
  2993.     case 'X':
  2994.       shrink:
  2995.         if (SvCUR(cat) < len)
  2996.         DIE("X outside of string");
  2997.         SvCUR(cat) -= len;
  2998.         *SvEND(cat) = '\0';
  2999.         break;
  3000.     case 'x':
  3001.       grow:
  3002.         while (len >= 10) {
  3003.         sv_catpvn(cat, null10, 10);
  3004.         len -= 10;
  3005.         }
  3006.         sv_catpvn(cat, null10, len);
  3007.         break;
  3008.     case 'A':
  3009.     case 'a':
  3010.         fromstr = NEXTFROM;
  3011.         aptr = SvPV(fromstr, fromlen);
  3012.         if (pat[-1] == '*')
  3013.         len = fromlen;
  3014.         if (fromlen > len)
  3015.         sv_catpvn(cat, aptr, len);
  3016.         else {
  3017.         sv_catpvn(cat, aptr, fromlen);
  3018.         len -= fromlen;
  3019.         if (datumtype == 'A') {
  3020.             while (len >= 10) {
  3021.             sv_catpvn(cat, space10, 10);
  3022.             len -= 10;
  3023.             }
  3024.             sv_catpvn(cat, space10, len);
  3025.         }
  3026.         else {
  3027.             while (len >= 10) {
  3028.             sv_catpvn(cat, null10, 10);
  3029.             len -= 10;
  3030.             }
  3031.             sv_catpvn(cat, null10, len);
  3032.         }
  3033.         }
  3034.         break;
  3035.     case 'B':
  3036.     case 'b':
  3037.         {
  3038.         char *savepat = pat;
  3039.         I32 saveitems;
  3040.  
  3041.         fromstr = NEXTFROM;
  3042.         saveitems = items;
  3043.         aptr = SvPV(fromstr, fromlen);
  3044.         if (pat[-1] == '*')
  3045.             len = fromlen;
  3046.         pat = aptr;
  3047.         aint = SvCUR(cat);
  3048.         SvCUR(cat) += (len+7)/8;
  3049.         SvGROW(cat, SvCUR(cat) + 1);
  3050.         aptr = SvPVX(cat) + aint;
  3051.         if (len > fromlen)
  3052.             len = fromlen;
  3053.         aint = len;
  3054.         items = 0;
  3055.         if (datumtype == 'B') {
  3056.             for (len = 0; len++ < aint;) {
  3057.             items |= *pat++ & 1;
  3058.             if (len & 7)
  3059.                 items <<= 1;
  3060.             else {
  3061.                 *aptr++ = items & 0xff;
  3062.                 items = 0;
  3063.             }
  3064.             }
  3065.         }
  3066.         else {
  3067.             for (len = 0; len++ < aint;) {
  3068.             if (*pat++ & 1)
  3069.                 items |= 128;
  3070.             if (len & 7)
  3071.                 items >>= 1;
  3072.             else {
  3073.                 *aptr++ = items & 0xff;
  3074.                 items = 0;
  3075.             }
  3076.             }
  3077.         }
  3078.         if (aint & 7) {
  3079.             if (datumtype == 'B')
  3080.             items <<= 7 - (aint & 7);
  3081.             else
  3082.             items >>= 7 - (aint & 7);
  3083.             *aptr++ = items & 0xff;
  3084.         }
  3085.         pat = SvPVX(cat) + SvCUR(cat);
  3086.         while (aptr <= pat)
  3087.             *aptr++ = '\0';
  3088.  
  3089.         pat = savepat;
  3090.         items = saveitems;
  3091.         }
  3092.         break;
  3093.     case 'H':
  3094.     case 'h':
  3095.         {
  3096.         char *savepat = pat;
  3097.         I32 saveitems;
  3098.  
  3099.         fromstr = NEXTFROM;
  3100.         saveitems = items;
  3101.         aptr = SvPV(fromstr, fromlen);
  3102.         if (pat[-1] == '*')
  3103.             len = fromlen;
  3104.         pat = aptr;
  3105.         aint = SvCUR(cat);
  3106.         SvCUR(cat) += (len+1)/2;
  3107.         SvGROW(cat, SvCUR(cat) + 1);
  3108.         aptr = SvPVX(cat) + aint;
  3109.         if (len > fromlen)
  3110.             len = fromlen;
  3111.         aint = len;
  3112.         items = 0;
  3113.         if (datumtype == 'H') {
  3114.             for (len = 0; len++ < aint;) {
  3115.             if (isALPHA(*pat))
  3116.                 items |= ((*pat++ & 15) + 9) & 15;
  3117.             else
  3118.                 items |= *pat++ & 15;
  3119.             if (len & 1)
  3120.                 items <<= 4;
  3121.             else {
  3122.                 *aptr++ = items & 0xff;
  3123.                 items = 0;
  3124.             }
  3125.             }
  3126.         }
  3127.         else {
  3128.             for (len = 0; len++ < aint;) {
  3129.             if (isALPHA(*pat))
  3130.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  3131.             else
  3132.                 items |= (*pat++ & 15) << 4;
  3133.             if (len & 1)
  3134.                 items >>= 4;
  3135.             else {
  3136.                 *aptr++ = items & 0xff;
  3137.                 items = 0;
  3138.             }
  3139.             }
  3140.         }
  3141.         if (aint & 1)
  3142.             *aptr++ = items & 0xff;
  3143.         pat = SvPVX(cat) + SvCUR(cat);
  3144.         while (aptr <= pat)
  3145.             *aptr++ = '\0';
  3146.  
  3147.         pat = savepat;
  3148.         items = saveitems;
  3149.         }
  3150.         break;
  3151.     case 'C':
  3152.     case 'c':
  3153.         while (len-- > 0) {
  3154.         fromstr = NEXTFROM;
  3155.         aint = SvIV(fromstr);
  3156.         achar = aint;
  3157.         sv_catpvn(cat, &achar, sizeof(char));
  3158.         }
  3159.         break;
  3160.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  3161.     case 'f':
  3162.     case 'F':
  3163.         while (len-- > 0) {
  3164.         fromstr = NEXTFROM;
  3165.         afloat = (float)SvNV(fromstr);
  3166.         sv_catpvn(cat, (char *)&afloat, sizeof (float));
  3167.         }
  3168.         break;
  3169.     case 'd':
  3170.     case 'D':
  3171.         while (len-- > 0) {
  3172.         fromstr = NEXTFROM;
  3173.         adouble = (double)SvNV(fromstr);
  3174.         sv_catpvn(cat, (char *)&adouble, sizeof (double));
  3175.         }
  3176.         break;
  3177.     case 'n':
  3178.         while (len-- > 0) {
  3179.         fromstr = NEXTFROM;
  3180.         ashort = (I16)SvIV(fromstr);
  3181. #ifdef HAS_HTONS
  3182.         ashort = htons(ashort);
  3183. #endif
  3184.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3185.         }
  3186.         break;
  3187.     case 'v':
  3188.         while (len-- > 0) {
  3189.         fromstr = NEXTFROM;
  3190.         ashort = (I16)SvIV(fromstr);
  3191. #ifdef HAS_HTOVS
  3192.         ashort = htovs(ashort);
  3193. #endif
  3194.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3195.         }
  3196.         break;
  3197.     case 'S':
  3198.     case 's':
  3199.         while (len-- > 0) {
  3200.         fromstr = NEXTFROM;
  3201.         ashort = (I16)SvIV(fromstr);
  3202.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3203.         }
  3204.         break;
  3205.     case 'I':
  3206.         while (len-- > 0) {
  3207.         fromstr = NEXTFROM;
  3208.         auint = U_I(SvNV(fromstr));
  3209.         sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
  3210.         }
  3211.         break;
  3212.     case 'i':
  3213.         while (len-- > 0) {
  3214.         fromstr = NEXTFROM;
  3215.         aint = SvIV(fromstr);
  3216.         sv_catpvn(cat, (char*)&aint, sizeof(int));
  3217.         }
  3218.         break;
  3219.     case 'N':
  3220.         while (len-- > 0) {
  3221.         fromstr = NEXTFROM;
  3222.         aulong = U_L(SvNV(fromstr));
  3223. #ifdef HAS_HTONL
  3224.         aulong = htonl(aulong);
  3225. #endif
  3226.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3227.         }
  3228.         break;
  3229.     case 'V':
  3230.         while (len-- > 0) {
  3231.         fromstr = NEXTFROM;
  3232.         aulong = U_L(SvNV(fromstr));
  3233. #ifdef HAS_HTOVL
  3234.         aulong = htovl(aulong);
  3235. #endif
  3236.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3237.         }
  3238.         break;
  3239.     case 'L':
  3240.         while (len-- > 0) {
  3241.         fromstr = NEXTFROM;
  3242.         aulong = U_L(SvNV(fromstr));
  3243.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3244.         }
  3245.         break;
  3246.     case 'l':
  3247.         while (len-- > 0) {
  3248.         fromstr = NEXTFROM;
  3249.         along = SvIV(fromstr);
  3250.         sv_catpvn(cat, (char*)&along, sizeof(I32));
  3251.         }
  3252.         break;
  3253. #ifdef HAS_QUAD
  3254.     case 'Q':
  3255.         while (len-- > 0) {
  3256.         fromstr = NEXTFROM;
  3257.         auquad = (unsigned Quad_t)SvIV(fromstr);
  3258.         sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
  3259.         }
  3260.         break;
  3261.     case 'q':
  3262.         while (len-- > 0) {
  3263.         fromstr = NEXTFROM;
  3264.         aquad = (Quad_t)SvIV(fromstr);
  3265.         sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
  3266.         }
  3267.         break;
  3268. #endif /* HAS_QUAD */
  3269.     case 'P':
  3270.         len = 1;        /* assume SV is correct length */
  3271.         /* FALL THROUGH */
  3272.     case 'p':
  3273.         while (len-- > 0) {
  3274.         fromstr = NEXTFROM;
  3275.         aptr = SvPV_force(fromstr, na);    /* XXX Error if TEMP? */
  3276.         sv_catpvn(cat, (char*)&aptr, sizeof(char*));
  3277.         }
  3278.         break;
  3279.     case 'u':
  3280.         fromstr = NEXTFROM;
  3281.         aptr = SvPV(fromstr, fromlen);
  3282.         SvGROW(cat, fromlen * 4 / 3);
  3283.         if (len <= 1)
  3284.         len = 45;
  3285.         else
  3286.         len = len / 3 * 3;
  3287.         while (fromlen > 0) {
  3288.         I32 todo;
  3289.  
  3290.         if (fromlen > len)
  3291.             todo = len;
  3292.         else
  3293.             todo = fromlen;
  3294.         doencodes(cat, aptr, todo);
  3295.         fromlen -= todo;
  3296.         aptr += todo;
  3297.         }
  3298.         break;
  3299.     }
  3300.     }
  3301.     SvSETMAGIC(cat);
  3302.     SP = ORIGMARK;
  3303.     PUSHs(cat);
  3304.     RETURN;
  3305. }
  3306. #undef NEXTFROM
  3307.  
  3308. PP(pp_split)
  3309. {
  3310.     dSP; dTARG;
  3311.     AV *ary;
  3312.     register I32 limit = POPi;            /* note, negative is forever */
  3313.     SV *sv = POPs;
  3314.     STRLEN len;
  3315.     register char *s = SvPV(sv, len);
  3316.     char *strend = s + len;
  3317.     register PMOP *pm = (PMOP*)POPs;
  3318.     register SV *dstr;
  3319.     register char *m;
  3320.     I32 iters = 0;
  3321.     I32 maxiters = (strend - s) + 10;
  3322.     I32 i;
  3323.     char *orig;
  3324.     I32 origlimit = limit;
  3325.     I32 realarray = 0;
  3326.     I32 base;
  3327.     AV *oldstack = stack;
  3328.     register REGEXP *rx = pm->op_pmregexp;
  3329.     I32 gimme = GIMME;
  3330.     I32 oldsave = savestack_ix;
  3331.  
  3332.     if (!pm || !s)
  3333.     DIE("panic: do_split");
  3334.     if (pm->op_pmreplroot)
  3335.     ary = GvAVn((GV*)pm->op_pmreplroot);
  3336.     else if (gimme != G_ARRAY)
  3337.     ary = GvAVn(defgv);
  3338.     else
  3339.     ary = Nullav;
  3340.     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
  3341.     realarray = 1;
  3342.     if (!AvREAL(ary)) {
  3343.         AvREAL_on(ary);
  3344.         for (i = AvFILL(ary); i >= 0; i--)
  3345.         AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
  3346.     }
  3347.     av_extend(ary,0);
  3348.     av_clear(ary);
  3349.     /* temporarily switch stacks */
  3350.     SWITCHSTACK(stack, ary);
  3351.     }
  3352.     base = SP - stack_base;
  3353.     orig = s;
  3354.     if (pm->op_pmflags & PMf_SKIPWHITE) {
  3355.     while (isSPACE(*s))
  3356.         s++;
  3357.     }
  3358.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  3359.     SAVEINT(multiline);
  3360.     multiline = pm->op_pmflags & PMf_MULTILINE;
  3361.     }
  3362.  
  3363.     if (!limit)
  3364.     limit = maxiters + 2;
  3365.     if (pm->op_pmflags & PMf_WHITE) {
  3366.     while (--limit) {
  3367.         /*SUPPRESS 530*/
  3368.         for (m = s; m < strend && !isSPACE(*m); m++) ;
  3369.         if (m >= strend)
  3370.         break;
  3371.         dstr = NEWSV(30, m-s);
  3372.         sv_setpvn(dstr, s, m-s);
  3373.         if (!realarray)
  3374.         sv_2mortal(dstr);
  3375.         XPUSHs(dstr);
  3376.         /*SUPPRESS 530*/
  3377.         for (s = m + 1; s < strend && isSPACE(*s); s++) ;
  3378.     }
  3379.     }
  3380.     else if (strEQ("^", rx->precomp)) {
  3381.     while (--limit) {
  3382.         /*SUPPRESS 530*/
  3383.         for (m = s; m < strend && *m != '\n'; m++) ;
  3384.         m++;
  3385.         if (m >= strend)
  3386.         break;
  3387.         dstr = NEWSV(30, m-s);
  3388.         sv_setpvn(dstr, s, m-s);
  3389.         if (!realarray)
  3390.         sv_2mortal(dstr);
  3391.         XPUSHs(dstr);
  3392.         s = m;
  3393.     }
  3394.     }
  3395.     else if (pm->op_pmshort) {
  3396.     i = SvCUR(pm->op_pmshort);
  3397.     if (i == 1) {
  3398.         I32 fold = (pm->op_pmflags & PMf_FOLD);
  3399.         i = *SvPVX(pm->op_pmshort);
  3400.         if (fold && isUPPER(i))
  3401.         i = toLOWER(i);
  3402.         while (--limit) {
  3403.         if (fold) {
  3404.             for ( m = s;
  3405.               m < strend && *m != i &&
  3406.                 (!isUPPER(*m) || toLOWER(*m) != i);
  3407.               m++)            /*SUPPRESS 530*/
  3408.             ;
  3409.         }
  3410.         else                /*SUPPRESS 530*/
  3411.             for (m = s; m < strend && *m != i; m++) ;
  3412.         if (m >= strend)
  3413.             break;
  3414.         dstr = NEWSV(30, m-s);
  3415.         sv_setpvn(dstr, s, m-s);
  3416.         if (!realarray)
  3417.             sv_2mortal(dstr);
  3418.         XPUSHs(dstr);
  3419.         s = m + 1;
  3420.         }
  3421.     }
  3422.     else {
  3423. #ifndef lint
  3424.         while (s < strend && --limit &&
  3425.           (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
  3426.             pm->op_pmshort)) )
  3427. #endif
  3428.         {
  3429.         dstr = NEWSV(31, m-s);
  3430.         sv_setpvn(dstr, s, m-s);
  3431.         if (!realarray)
  3432.             sv_2mortal(dstr);
  3433.         XPUSHs(dstr);
  3434.         s = m + i;
  3435.         }
  3436.     }
  3437.     }
  3438.     else {
  3439.     maxiters += (strend - s) * rx->nparens;
  3440.     while (s < strend && --limit &&
  3441.         pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
  3442.         if (rx->subbase
  3443.           && rx->subbase != orig) {
  3444.         m = s;
  3445.         s = orig;
  3446.         orig = rx->subbase;
  3447.         s = orig + (m - s);
  3448.         strend = s + (strend - m);
  3449.         }
  3450.         m = rx->startp[0];
  3451.         dstr = NEWSV(32, m-s);
  3452.         sv_setpvn(dstr, s, m-s);
  3453.         if (!realarray)
  3454.         sv_2mortal(dstr);
  3455.         XPUSHs(dstr);
  3456.         if (rx->nparens) {
  3457.         for (i = 1; i <= rx->nparens; i++) {
  3458.             s = rx->startp[i];
  3459.             m = rx->endp[i];
  3460.             if (m && s) {
  3461.             dstr = NEWSV(33, m-s);
  3462.             sv_setpvn(dstr, s, m-s);
  3463.             }
  3464.             else
  3465.             dstr = NEWSV(33, 0);
  3466.             if (!realarray)
  3467.             sv_2mortal(dstr);
  3468.             XPUSHs(dstr);
  3469.         }
  3470.         }
  3471.         s = rx->endp[0];
  3472.     }
  3473.     }
  3474.     LEAVE_SCOPE(oldsave);
  3475.     iters = (SP - stack_base) - base;
  3476.     if (iters > maxiters)
  3477.     DIE("Split loop");
  3478.     
  3479.     /* keep field after final delim? */
  3480.     if (s < strend || (iters && origlimit)) {
  3481.     dstr = NEWSV(34, strend-s);
  3482.     sv_setpvn(dstr, s, strend-s);
  3483.     if (!realarray)
  3484.         sv_2mortal(dstr);
  3485.     XPUSHs(dstr);
  3486.     iters++;
  3487.     }
  3488.     else if (!origlimit) {
  3489.     while (iters > 0 && SvCUR(TOPs) == 0)
  3490.         iters--, SP--;
  3491.     }
  3492.     if (realarray) {
  3493.     SWITCHSTACK(ary, oldstack);
  3494.     if (gimme == G_ARRAY) {
  3495.         EXTEND(SP, iters);
  3496.         Copy(AvARRAY(ary), SP + 1, iters, SV*);
  3497.         SP += iters;
  3498.         RETURN;
  3499.     }
  3500.     }
  3501.     else {
  3502.     if (gimme == G_ARRAY)
  3503.         RETURN;
  3504.     }
  3505.     if (iters || !pm->op_pmreplroot) {
  3506.     GETTARGET;
  3507.     PUSHi(iters);
  3508.     RETURN;
  3509.     }
  3510.     RETPUSHUNDEF;
  3511. }
  3512.  
  3513.